a few patches to dbase
Curtis Villamizar
Thu May 4 19:51:24 CEST 1995
Dear Keepers of the Source, As you may have heard, we have a large and ugly machine generated aut-num object which allows us to transition from AS690 advisories without changing the way routing works for any network. While we are not particularly fond of this 15,000 line RIPE object, it does make a gradual transition possible. We hope to work with providers to reduce the policy descriptions to something manageable. This aut-num created a big performance problem for most of the RIPE tools. On a 486/33 (my home machine) dbupdate could not load this object in 12 hours. With just 2 fixes, it is down to under 8 minutes. I think these patches are worth putting in the base distribution. I have some small patches to the following files. Also, I modified the Makefile and created a config.generic file and have the Makefile doing substitutions to elinate a lot of editing. cleandb.pl.patch.950504 enparse.pl.patch.950504 dbopen.pl.patch.950504 misc.pl.patch.950504 dbupdate.pl.patch.950504 syntax.pl.patch.950504 The patches are below. I'll send the files Makefile, Makefile.generic and config.generic in a separate message in case anyone wants them. Curtis -------------------------------- Notes on the patches: cleandb.pl - Doesn't fail if thmp directory already exists. If it does fail it tells you the name of the directory it couldn't create. dbopen.pl - Some more debuging info if opt_V is set. dbupdate.pl - added "-m mail-address" option. Fixed Getopts line. - minor debugging additions if opt_V is set enparse.pl - small change, major performance improvement, read the comment - minor debugging additions if opt_V is set misc.pl - speedup to isnetlist, not sure if it helps much - added update_the_time function for some performance debugging syntax.pl - debugging added if opt_V set to track progress and performance - moved "$object{$itmp} =~ " lines out of ineer loops, for an aut-num with 10,000+ [inter]as-{in,out} lines, this avoids evaluating this costly statement 10,000+ times. Goes faster. Feel free to toss the debugging stuff if you feel it is ugly or excessive. It has no effect if you don't put -V on the command line. -------------------------------- *** cleandb.pl.orig Thu May 4 03:51:45 1995 --- cleandb.pl Thu May 4 03:57:21 1995 *************** *** 418,426 **** $NEWDIR = "$ARGV[0].new"; $NEWDB = "$NEWDIR/$fileext"; ! if (!mkdir($NEWDIR, 0750)) { &dbclose(*i); ! die "Failed to create temporary directory: $!"; } if ($opt_v) { --- 418,426 ---- $NEWDIR = "$ARGV[0].new"; $NEWDB = "$NEWDIR/$fileext"; ! if ((! -d $NEWDIR) && !mkdir($NEWDIR, 0750)) { &dbclose(*i); ! die "Failed to create temporary directory \"$NEWDIR\": $!"; } if ($opt_v) { *** dbopen.pl.orig Mon Apr 24 10:51:19 1995 --- dbopen.pl Wed May 3 12:52:10 1995 *************** *** 24,30 **** --- 24,32 ---- if ($TYPE{$source} eq "SPLIT") { $name .= ".".$type; } + print STDERR " $source -> $DBFILE{$source} + $type ->\n\t" if $opt_V; } + print STDERR "dbopen: $name\n" if $opt_V; if ($write) { *** dbupdate.pl.orig Mon Apr 24 10:51:19 1995 --- dbupdate.pl Thu May 4 12:09:54 1995 *************** *** 35,40 **** --- 35,42 ---- # -l logfile - log output to file in stead of STDOUT # -n logtext - Network update - use logtext in acklog file # -v - verbose output (LONGACK) + # -m mail-address - treat as mail from mail-address for the purpose + # of MAIL-FROM style authorization # -M - treat input file (or STDIN) as mail and compose # and send ack mail back # -A - assume "assign" mode, only add will be allowed *************** *** 46,52 **** # -F - Do fast update without mail and other stuff # -S - Do only syntax check - Not implemented ! &Getopts('ln:vMAHVFS'); # Need this below for running perl in tainted mode. --- 48,59 ---- # -F - Do fast update without mail and other stuff # -S - Do only syntax check - Not implemented ! &Getopts("l:m:n:vMAHVFS"); ! ! if ($opt_m) { ! $FROM = "$opt_m"; ! print STDERR "Treating as mail from $FROM\n" if ($opt_V) ! } # Need this below for running perl in tainted mode. *************** *** 323,328 **** --- 330,336 ---- # Not too good, probably permission problem # if this is given as output ... + print STDERR "dbupdate - open database failed\n" if $opt_V; &adderror(*entry, "Failed to open DB file: $!"); &adderror(*entry, "Please check the \"source:\" value"); &adderror(*entry, "Contact <$HUMAILBOX> if source seems ok"); *** enparse.pl.orig Mon Apr 24 10:51:19 1995 --- enparse.pl Thu May 4 02:05:00 1995 *************** *** 32,46 **** --- 32,80 ---- require "defines.pl"; require "adderror.pl"; + # + # readsomething_xfer is just here to assist readsomething. + # An eval is used to load indexed arrays while readsomething + # runs. When it is done, a join is done loading the multiple + # lines into the entry associative array. readsomething_xfer + # does this join and gets rid of the indexed arrays. This is + # _much_ faster for long objects like the AS690 aut-num, reducing + # an operation that took over an hour down to about 2 minutes. + # + + sub readsomething_xfer { + if ($opt_V) { + &update_the_time(); + print STDERR sprintf("readsomething completed %5d lines at %s\n", + $readsomething_counter, $the_time); + } + foreach $tag ( keys %tags ) { + eval "\$entry{\"$tag\"} = join(\'\n\', \@readsomething_$tag);" + . "undef \@readsomething_$tag;"; + } + if ($opt_V) { + &update_the_time(); + print STDERR "readsomething completed xfer at $the_time\n"; + } + } + sub readsomething { local($file) = @_; local($inentry) = $NOK; local($tag) = ""; local(%entry) = (); + local($readsomething_counter) = 0; + local(%tags) = (); while (<$file>) { + if ($opt_V && (((++$readsomething_counter) % 1000) == 0)) { + &update_the_time(); + print STDERR sprintf("readsomething completed %5d lines at %s\n", + $readsomething_counter, $the_time); + } + s/^\s*//; s/\s*$//; s/\n*$//; *************** *** 55,64 **** if (/^\*..:\s*(.*)/) { $inentry = $OK; $tag = substr($_, 1, 2); ! if ($entry{$tag}) { ! $entry{$tag} .= "\n"; ! } ! $entry{$tag} = $entry{$tag} . $1; next; } if (/^([a-z\-A-Z_]+)\s*:\s*(.*)/) { --- 89,96 ---- if (/^\*..:\s*(.*)/) { $inentry = $OK; $tag = substr($_, 1, 2); ! ++$tags{$tag}; ! eval "\$readsomething_$tag\[\$\#readsomething_$tag+1\] = \"$1\";"; next; } if (/^([a-z\-A-Z_]+)\s*:\s*(.*)/) { *************** *** 66,85 **** $tag = $1; $tag =~ tr/A-Z/a-z/; $tag = $ATTR{$tag} if $ATTR{$tag}; ! if ($entry{$tag}) { ! $entry{$tag} .= "\n"; ! } ! $entry{$tag} = $entry{$tag} . "$2"; next; } if (/^.*$/) { next if $inentry == $NOK; $CUROBJTYPE = &entype(*entry); return ($inentry,%entry); } } $CUROBJTYPE = &entype(*entry); return ($inentry, %entry) if ($inentry); return $EOF; --- 98,117 ---- $tag = $1; $tag =~ tr/A-Z/a-z/; $tag = $ATTR{$tag} if $ATTR{$tag}; ! ++$tags{$tag}; ! eval "\$readsomething_$tag\[\$\#readsomething_$tag+1\] = \"$2\";"; next; } if (/^.*$/) { next if $inentry == $NOK; + &readsomething_xfer(); $CUROBJTYPE = &entype(*entry); return ($inentry,%entry); } } + &readsomething_xfer(); $CUROBJTYPE = &entype(*entry); return ($inentry, %entry) if ($inentry); return $EOF; *************** *** 214,220 **** local($stat); local($hasdelete); ! print STDERR "enparse - reading something\n" if $opt_V; ($stat, %entry) = &readsomething($file); --- 246,255 ---- local($stat); local($hasdelete); ! if ($opt_V) { ! &update_the_time(); ! print STDERR "enparse - reading something at $the_time\n"; ! } ($stat, %entry) = &readsomething($file); *** misc.pl.orig Mon Apr 24 10:51:20 1995 --- misc.pl Wed May 3 15:40:08 1995 *************** *** 187,197 **** return 1; } # sub isnetlist { ! local($str) = @_; ! local($NET) = "\\d+\\.\\d+\\.\\d+\\.\\d+\\/\\d+"; ! return 0 if $str !~ /^\s*{\s*$NET\s*(\s*,\s*$NET\s*)*}\s*$/; return 1; } # --- 187,197 ---- return 1; } + # local($str) and local($NET) slows things down a lot + $__isnetlist__NET = "\\d+\\.\\d+\\.\\d+\\.\\d+\\/\\d+"; # sub isnetlist { ! return 0 if $_[0] !~ /^\s*{\s*$__isnetlist__NET\s*(\s*,\s*$__isnetlist__NET\s*)*}\s*$/; return 1; } # *************** *** 420,425 **** --- 420,435 ---- return 0 if $str =~ /[{}]/; return 1; } + + # + # getting a time stamp for performance logging + # + + sub update_the_time { + $the_time = `/bin/date +%H:%M:%S`; + $the_time =~ s/\n//; + } + # # exclusive locking # *** syntax.pl.orig Mon Apr 24 10:51:21 1995 --- syntax.pl Thu May 4 03:54:20 1995 *************** *** 77,86 **** local(*object) = @_; local($rtcode) =$O_OK; local($itmp, $val, $msg); ! print STDERR "checksyntax - called\n" if $opt_V; foreach $itmp (keys %object) { if ($object{$itmp} eq "") { ($val, $msg) = &dosyntax($itmp, "", *object); if ($val == $O_WARNING) { --- 77,96 ---- local(*object) = @_; local($rtcode) =$O_OK; local($itmp, $val, $msg); + local($checksyntax_counter) = 0; ! if ($opt_V) { ! &update_the_time(); ! print STDERR "checksyntax - called at $the_time\n"; ! } foreach $itmp (keys %object) { + if ($opt_V) { + &update_the_time(); + ++$checksyntax_counter; + print STDERR sprintf("checksyntax: item #%d \"%s\" at %s\n", + $checksyntax_counter, $itmp, $the_time); + } if ($object{$itmp} eq "") { ($val, $msg) = &dosyntax($itmp, "", *object); if ($val == $O_WARNING) { *************** *** 107,112 **** --- 117,124 ---- local($j,$k) = 0; local(%linewrap) = (); local(%newval) = (); + print STDERR "Checking syntax in \"$itmp\" " + . ($#array + 1) . " lines\n" if $opt_V; foreach $j (0..$#array) { # # as-in lines *************** *** 123,129 **** } else { ($peer, $wt, $pol) = split(/\s+/, $array[$j], 3); } - $object{$itmp} =~ s/from\s+|accept\s+//g; # # as-out lines # --- 135,140 ---- *************** *** 141,147 **** ($peer, $pol) = split(/\s+/, $array[$j], 2); $wt = 1; } - $object{$itmp} =~ s/to\s+|announce\s+//g; # # interas-in lines # --- 152,157 ---- *************** *** 165,171 **** split(/\s+/, $array[$j], 5); $wt = "$lid-$rid-$cost"; } - $object{$itmp} =~ s/from\s+|accept\s+//g; # # interas-out lines # --- 175,180 ---- *************** *** 206,212 **** $wt = "$lid-$rid"; } } - $object{$itmp} =~ s/to\s+|announce\s+//g; } # # Now finally check if the lines are the same. --- 215,220 ---- *************** *** 222,227 **** --- 230,248 ---- } $linewrap{"$peer:$wt"} = 1; } + print STDERR "Rebuilding \"$itmp\"\n" if $opt_V; + if($FLAG eq "ai") { + $object{$itmp} =~ s/from\s+|accept\s+//g; + } + if ($FLAG eq "ao") { + $object{$itmp} =~ s/to\s+|announce\s+//g; + } + if ($FLAG eq "it") { + $object{$itmp} =~ s/from\s+|accept\s+//g; + } + if ($FLAG eq "io") { + $object{$itmp} =~ s/to\s+|announce\s+//g; + } # # Now loop through the value and syntax check the re-built line # *************** *** 238,247 **** --- 259,270 ---- } } } + print STDERR "Finished Preprocessing \"$itmp\"\n" if $opt_V; # # Otherwise just split on newlines and pass line by line to syntax checker # } else { + print STDERR "Spliting \"$itmp\"\n" if $opt_V; foreach $j (split(/\n/, $object{$itmp})) { local($val, $msg) = &dosyntax($itmp, $j, *object); if ($val == $O_WARNING) { *************** *** 253,258 **** --- 276,282 ---- $rtcode = $O_ERROR; } } + print STDERR "Finished Preprocessing \"$itmp\"\n" if $opt_V; } } } *************** *** 264,269 **** --- 288,295 ---- local($key, $value, *object) = @_; + print STDERR "dosyntax: \"$key\"\n" if $opt_V; + # # THE FIRST SET OF ATTRIBUTES MAY NOT HAVE AN EMPTY VALUE IF THEY EXIST # *************** *** 432,437 **** --- 458,464 ---- "is not a routing policy KEYWORD"; } } + print STDERR "dosyntax: done \"$key\"\n" if $opt_V; return; } # *************** *** 1729,1733 **** --- 1756,1762 ---- if ($key eq "uw") { return; } + + print STDERR "dosyntax: DONE with \"$key\"\n" if $opt_V; } 1; -------- Logged at Thu May 4 20:10:45 MET DST 1995 ---------
[ rr-impl Archive ]