From: ijackson Date: Mon, 21 Jun 1999 17:23:41 +0000 (+0000) Subject: Improvements. X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=e2257c98bd6669a15c04bd5dbf57dddedf8c310b;p=bcp5-registry.git Improvements. --- diff --git a/.cvsignore b/.cvsignore index b8ed2a7..9ddd1e0 100644 --- a/.cvsignore +++ b/.cvsignore @@ -1 +1,3 @@ t.html +list +lockfile diff --git a/bcp5-registry.pl b/bcp5-registry.pl index e913582..309b9cb 100755 --- a/bcp5-registry.pl +++ b/bcp5-registry.pl @@ -4,69 +4,309 @@ require "$ARGV[0]/config.pl"; require 'database.pl'; if ("$ARGV[1]" eq '--cgi') { + open DEBUG,"/dev/null" or die $!; require 'cgi-lib.pl'; &ReadParse; } else { - foreach $x (@ARGV) { - $x =~ s/^(\w+)\=//; - $in{$1}= $x; + open DEBUG,">&STDERR" or die $!; + foreach $x (@ARGV[1..$#ARGV]) { + $x =~ m/^(\w+)\=/ or die "$x ?"; + $in{$1}= $'; + print DEBUG "$1 -> \"$'\"\n"; } } -@areas= split(/ /,'10.0.0.0/8 172.16.0.0/12 192.168.0.0/16'); -$rec_area= '172.16.0.0/12'; +@area_networks= qw(0a000000 ac100000 c0a80000); +@area_prefixes= qw(8 12 16); +$rec_areai= 1; -$current_area= $rec_area; -$view_area= ''; -$viewoverlap= ''; +$current_areai= $rec_areai; +$list_areai= -1; +$listoverlap= ''; $intro= 0; +$error= 0; $registernew= 0; $pick= 0; $details= 0; $fulldetails= 0; -$created= 0; -$updated= 0; +$justcreated= 0; +$justupdated= 0; $picked= 0; -$viewingall= 0; -$view= 1; +$listingall= 0; +$passwordsent= 0; +$list= 0; $notfound= 0; $id= ''; $name= ''; $email= ''; -$emailhidechecked= 0; +$emailhidechecked= ''; $hiddenemail= 0; -$viewingarea= length $view_area; -$viewingoverlap= length $viewoverlap; - -if ($in{'dbid'}) { - database(); - $id= $in{'dbid'}; - if (!exists $db{$id}) { - $notfound= 1; - $view= 0; - } else { - $details= 1; - getinfo(); - } + +$listingarea= $list_areai>=0; +$listingoverlap= length $listoverlap; + +open RAND,"/dev/urandom" or die $!; +defined($now= time) or die $!; + +if (length $in{'register'}) { + + lock_database(); + read_database(); + + $id= randnybs(16); + $generation= 0; + $db{$id}= $ent= { }; + $ent->{'created'}= $now; + $ent->{'changed'}= 0; + $email= $in{'email'}; + set_entry(); + + $justcreated= 1; + show_entry(); + finish(); + +} elsif (length $in{'mailpasswd'}) { + + read_database(); + get_entry(); + send_password(); + + $passwordsent= 1; + finish(); + +} elsif (length $in{'view'}) { + + read_database(); + get_entry(); + check_password(); + + $fulldetails= 1; + show_entry(); + finish(); + +} elsif (length $in{'update'}) { + + lock_database(); + get_entry(); + check_password(); + check_generation(); + + $ent->{'changed'}= $now; + $email= length($in{'email'}) ? $in{'email'} : $db{$id}->{'email'}; + set_entry(); + + $justupdated= 1; + show_entry(); + finish(); + +} elsif (length $in{'delete'}) { + + lock_database(); + get_entry(); + check_password(); + check_generation(); + + delete $db{$id}; + write_database(); + + $deleted= 1; + finish(); + +} elsif (length $in{'pick'}) { + + pick_net(); + $picked= 1; + $pick= 1; + $list= 1; + finish(); + +} elsif (length $in{'list'}) { + + read_database(); + list_database(); + $list= 1; + finish(); + +} elsif (length $in{'id'}) { + + read_database(); + get_entry(); + $details= 1; + show_entry(); + $list= 1; + $pick= 1; + finish(); + } else { + $intro= 1; - $registernew= 1; + $list= 1; $pick= 1; + $registernew= 1; + finish(); + +} + +sub set_entry () { + my $v, $b, @b, $val, $mask; + $name= $in{'name'}; + foreach $v (qw(name email)) { + length $$v or finish_error("no$v"); + finish_error("badchar") unless $$v =~ m/^[ -\176\240\376]+$/; $$v= $&; + } + $hiddenemail= !!length $in{'hiddenemail'}; + $net= $in{'net'}; +print DEBUG "got $net\n"; + $net =~ s,/(\d+)$,, or finish_error("badnet"); +print DEBUG "prefix $1\n"; + $prefix= $1+0; ($prefix >= 0 && $prefix <= 32) or finish_error("badnet"); +print DEBUG "prefix $1 $net\n"; + $network= ''; @b= split(/\./,$net); + @b<=4 or finish_error("badnet"); +print DEBUG "big enough\n"; + @b*8 >= $prefix or finish_error("badnet"); + while (@b<4) { push @b,0; } +print DEBUG "@b\n"; + foreach $b (@b) { + $b>=0 && $b<=255 or finish_error("badnet"); + $network .= sprintf("%02x",$b); + } +print DEBUG "$network\n"; + ($val,$mask) = net_valuemask($network,$prefix); +printf DEBUG "%08x %08x %08x\n", $val,$mask,~$mask; + !($val & ~$mask) or finish_error("badnet"); +print DEBUG "ok\n"; + $current_areai= find_areai($network,$prefix); +print DEBUG "$current_areai\n"; + $current_areai>=0 or finish_error("wrongnet"); +print DEBUG "ok\n"; + + foreach $k (qw(generation network prefix name email hiddenemail)) { + $ent->{$k}= $$k; + } + + write_database(); } -open X, "template.html" or die $!; -@x= ; -close X or die $!; +sub find_areai ($$) { + my ($network,$prefix) = @_; + my $i; + for ($i=0; $i<@area_networks; $i++) { + next unless net_subset($network,$prefix, $area_networks[$i],$area_prefixes[$i]); + return $i; + } + return -1; +} -$x[$#x] eq "\@\@\@eof:\@\@\@\n" or die $!; -$#x--; +sub net_subset ($$$$) { + my ($smln,$smlp, $bign,$bigp) = @_; + return 0 unless $smlp >= $bigp; + ($bigv,$bigm) = net_valuemask($bign,$bigp); + ($smlv,$smlm) = net_valuemask($bign,$bigp); + return 0 unless ($smlv & $bigm) == $bigv; + return 1; +} -$cl= 0; -$level= -1; -process(1); +sub net_valuemask($$) { + my ($network,$prefix) = @_; + return (hex($network), (0xffffffff << (32-$prefix))); +} -close STDOUT or die $!; +sub get_entry () { + length $in{'id'} or die; + $id= $in{'id'}; + exists $db{$id} or finish_error('notfound'); + $ent= $db{$id}; +} + +sub show_entry () { + my $k, $dk; + foreach $k (@db_fields) { + $$k= $ent->{$k}; + } + foreach $k (qw(created changed)) { + $dk= "date$k"; + $$dk= gmtime($$k)." GMT"; + } + $net= display_net($network,$prefix); +} + +sub list_database () { + my $t, $v, $k, $x; + $listing= ''; + foreach $t (qw(all area overlap)) { + $listing= $t if length $in{"list$t"}; + } + die unless $listing; + $v= "listing$listing"; $$v= 1; + &{"dblist_prep_$listing"}(); + @kl= (); +print DEBUG "ldb 1 @kl\n"; + foreach $k (keys %db) { +print DEBUG "ldb q $k\n"; + next unless &{"dblist_cond_$listing"}($db{$k}); + push @kl,$k; + } +print DEBUG "ldb 2 @kl\n"; + @kl= sort { + $x= $db{$a}->{'network'} cmp $db{$b}->{'network'}; return $x if $x; + $x= $db{$a}->{'prefix'} <=> $db{$b}->{'prefix'}; return $x if $x; + return -1 if $a eq 'picked' && $b ne 'picked'; + return +1 if $b eq 'picked' && $a ne 'picked';; + $x= $db{$a}->{'name'} cmp $db{$b}->{'name'}; return $x if $x; + return $a cmp $b; + } @kl; +print DEBUG "ldb 3 @kl\n"; + $listingnonefound= @kl ? 0 : 1; +print DEBUG "ldb end $listingnonefound\n"; +} + +sub check_generation () { + $ent->{'generation'} eq $ent->{'generation'} or finish_error('generation'); +} + +sub finish_error ($) { + my ($type) = @_; + my $t, $esel; + foreach $t (qw(noemail noname badnet wrongnet notfound generation badchar)) { + $esel= "error_$t"; + $$esel= 0; + } + my $esel= "error_$type"; + $$esel= 1; + $error= 1; + finish(); +} + +sub finish () { + open X, "template.html" or die $!; + @x= ; + close X or die $!; + + $x[$#x] eq "\@\@\@eof:\@\@\@\n" or die $!; + $#x--; + + $cl= 0; + $level= -1; + process(1); + + close STDOUT or die $!; + exit 0; +} + +sub display_net ($$) { + my ($network,$prefix) = @_; + return join('.', unpack("C4",pack("H8",$network)))."/".$prefix; +} + +sub randnybs ($) { + my ($nybbles) = @_; + my $v; + my $bytes= $nybbles/2; + read(RAND,$v,$bytes) == $bytes or die $!; + return scalar unpack("H$nybbles",$v) +} sub out ($) { print $_[0],"\n" or die $!; @@ -123,18 +363,46 @@ sub getvar ($) { return $$vn; } +sub dblist_prep_all { } +sub dblist_cond_all { 1; } + sub foreach_start_area { $area_i=0; } -sub foreach_cond_area { return $area_i < @areas; } +sub foreach_cond_area { return $area_i < @area_networks; } sub foreach_incr_area { $area_i++; } sub foreach_setvars_area { - $area= $areas[$area_i]; - $area_recommended= $area eq $rec_area; - $area_pickchecked= $area eq $current_area ? 'checked' : ''; - $area_viewing= $area eq $viewing_area; - out(""); + $area_network= $area_networks[$area_i]; + $area= display_net($area_network,$area_prefixes[$area_i]); + $area_recommended= $area_i==$rec_areai; + $area_pickchecked= $area_i==$current_areai ? 'checked' : ''; + $area_listing= $area_i==$list_areai; +# out(""); +} + +%saniarray= ('<','lt', '>','gt', '&','amp', '"','quot'); +sub html_sani { + local ($in) = @_; + local ($out); + while ($in =~ m/[<>&"]/) { + $out.= $`. '&'. $saniarray{$&}. ';'; + $in=$'; + } + $out.= $in; + $out; } -sub foreach_start_db { } -sub foreach_cond_db { 0; } -sub foreach_setvars_db { } -sub foreach_incr_db { } +sub foreach_start_db { $db_i=0; } +sub foreach_cond_db { return $db_i < @kl; } +sub foreach_incr_db { $db_i++; } +sub foreach_setvars_db { + my $k, $ent; + $k= $kl[$db_i]; + $ent= $db{$k}; + if ($k eq 'picked') { + unset $db_id; + } else { + $db_id= $k; + } + $db_net= display_net($ent->{'network'}, $ent->{'prefix'}); + $db_name= html_sani($ent->{'name'}); + $db_email= $ent->{'hiddenemail'} ? "" : html_sani($ent->{'email'}); +} diff --git a/config.pl b/config.pl index 2a16b3b..1e723a2 100644 --- a/config.pl +++ b/config.pl @@ -3,3 +3,4 @@ $adminemail= 'ijackson+cam-bcp5@chiark.greenend.org.uk'; $nameboxlen= 55; $emailboxlen= 55; $cgi= 'http://www.chiark.greenend.org.uk/ucgi/~ijackson/bcp5-registry'; +chdir("$ARGV[0]"); diff --git a/database.pl b/database.pl index a85cd67..1d7b1f0 100644 --- a/database.pl +++ b/database.pl @@ -1,5 +1,49 @@ # -sub database () { } +@db_fields= qw(generation network prefix name email hiddenemail created changed); + +sub read_database () { +print DEBUG "reading\n"; + my @v,$id; + open DBF, "list" or die $!; + for (;;) { + $_= ; + length or die "$_ $!"; + s/\n$//; + last if m/^\002/; + @v= split(/\001/,$_); + $id= shift @v; + length $id or die; + undef $v; + foreach $f (@db_fields) { $v->{$f}= shift(@v).''; } + $db{$id}= $v; + } + close DBF or die $!; + $db_read= 1; +} + +sub write_database () { + my $k,$v; +print DEBUG "writing\n"; + die unless $ENV{'BCP5_REGISTRY_LOCKED'}; + open DBF, ">list.new" or die $!; + while (($k,$v) = each %db) { + $str= "$k"; + foreach $f (@db_fields) { $str.= "\1".$v->{$f}; } + print DBF $str,"\n" or die $!; + } + print DBF "\2\n" or die $!; + close DBF or die $!; + rename "list.new","list" or die $!; +} + +sub lock_database () { +print DEBUG "locking\n"; + die if $db_read; + return if $ENV{'BCP5_REGISTRY_LOCKED'}; + $ENV{'BCP5_REGISTRY_LOCKED'}= '1'; + exec 'with-lock-ex','-w','lockfile',$0,@ARGV; + die $!; +} 1; diff --git a/template.html b/template.html index 55f7048..84e224d 100644 --- a/template.html +++ b/template.html @@ -11,33 +11,42 @@ @@@net@@@ picked @@@endif:@@@ +@@@if:passwordsent@@@ +password sent for @@@name@@@ +@@@endif:@@@ + @@@if:details@@@ details of @@@name@@@ @@@endif:@@@ -@@@if:created@@@ +@@@if:justcreated@@@ registered @@@name@@@ @@@endif:@@@ -@@@if:updated@@@ +@@@if:justupdated@@@ updated @@@name@@@ @@@endif:@@@ -@@@if:viewingall@@@ +@@@if:listingall@@@ entire database @@@endif:@@@ -@@@if:viewingarea@@@ -subset for @@@viewarea@@@ +@@@if:listingarea@@@ +subset for @@@listarea@@@ @@@endif:@@@ -@@@if:viewingoverlap@@@ -overlapping with @@@viewoverlap@@@ +@@@if:listingoverlap@@@ +overlapping with @@@listoverlap@@@ @@@endif:@@@ -@@@if:notfound@@@ +@@@if:error@@@ +@@@if:error_notfound@@@ entry not found @@@endif:@@@ +@@@ifnot:error_notfound@@@ +error +@@@endif:@@@ +@@@endif:@@@ @@@endif:@@@ @@ -60,29 +69,34 @@ Random network picked: @@@net@@@ Database entry details: @@@name@@@ @@@endif:@@@ -@@@if:created@@@ +@@@if:justcreated@@@ @@@name@@@ registered in database @@@endif:@@@ -@@@if:updated@@@ +@@@if:justupdated@@@ Database entry updated: @@@name@@@ @@@endif:@@@ -@@@if:viewingall@@@ +@@@if:listingall@@@ Entire database listing @@@endif:@@@ -@@@if:viewingarea@@@ -Database subset listing for @@@viewarea@@@ +@@@if:listingarea@@@ +Database subset listing for @@@listarea@@@ @@@endif:@@@ -@@@if:viewingoverlap@@@ -Database search, entries overlapping with @@@viewoverlap@@@ +@@@if:listingoverlap@@@ +Database search, entries overlapping with @@@listoverlap@@@ @@@endif:@@@ -@@@if:notfound@@@ +@@@if:error@@@ +@@@if:error_notfound@@@ Database entry not found @@@endif:@@@ +@@@ifnot:error_notfound@@@ +An error has occurred +@@@endif:@@@ +@@@endif:@@@ @@ -113,6 +127,51 @@ by anyone else. @@@endif:@@@ +@@@if:error@@@ + +@@@if:error_badnet@@@ +You entered a syntactically invalid CIDR-format network number. +

+IPv4 network numbers should be expressed as a dotted quad followed by +a prefix length. Each of the numbers in the dotted quad must be +between 0 and 255. The prefix length is separated from the dotted +quad by a slash, and must be between 0 and 32. None of the bits in +the dotted quad beyond the prefix length must be set. +@@@endif:@@@ + +@@@if:error_wrongnet@@@ +The network number you specified does not lie wholly within the +BCP5-allocated private-use address ranges. +@@@endif:@@@ + +@@@if:error_notfound@@@ +Sorry, the database entry cannot be found. Perhaps the entry has been +deleted or expired. +

+If you believe that this has happened to you in error, contact the +registry administrator, @@@adminemail@@@, quoting identifier @@@id@@@. +@@@endif:@@@ + +@@@if:error_generation@@@ +Another modification has been made to the record. Please use the +`view' option to see the new values, before making any further +changes. +@@@endif:@@@ + +@@@if:error_noemail@@@ +You must provide an email address. +@@@endif:@@@ + +@@@if:error_noname@@@ +You must provide a network name for the database. +@@@endif:@@@ + +@@@if:error_badchar@@@ +The name or email address you specified contains illegal character(s). +@@@endif:@@@ + +@@@endif:@@@ + @@@if:registernew@@@

Register a network range you are using

You may register an existing network range you are using in our @@ -144,7 +203,7 @@ the entry.

Entry details

@@@endif:@@@ -@@@if:created@@@ +@@@if:justcreated@@@

Entry created

The database entry has been created, but will only persist for a short time unless you confirm it. You have beeen sent an email requesting @@ -153,13 +212,13 @@ confirmation, or return at a later date when you have received the email. @@@endif:@@@ -@@@if:updated@@@ +@@@if:justupdated@@@

Entry updated/confirmed

The database entry below has been updated/confirmed/renewed. @@@endif:@@@ -@@@if:registernew|details|fulldetails|created|updated|picked@@@ +@@@if:registernew|details|fulldetails|justcreated|justupdated|picked@@@

@@ -171,7 +230,7 @@ Network range: @@@net@@@ @@@endif:@@@ @@@ifnot:picked@@@ - + @@@endif:@@@
@@ -188,50 +247,62 @@ New address:
- + Hide email address from public database. @@@if:registernew|picked@@@ @@@endif:@@@ -@@@if:details|fulldetails|created|updated@@@ +@@@if:details|fulldetails|justcreated|justupdated@@@

Entry created: @@@datecreated@@@
-Last update: @@@datechanged@@@
-Confirmed/renewed: @@@dateconfirmed@@@ +@@@if:changed@@@ +Last update/confirm: @@@datechanged@@@
+@@@endif:@@@ +@@@ifnot:changed@@@ +Not yet confirmed. +@@@endif:@@@ + @@@endif:@@@ @@@if:details@@@ -

+

Password request

Use this to obtain your password. Passwords expire after a while; if you do not have a recent notification of your password, you should request a current password:
-

@@@endif:@@@ -@@@if:details|created@@@ +@@@if:details|fulldetails|justcreated|justupdated@@@ +

Modify or manage existing entry

+@@@endif:@@@ + +@@@if:details|justcreated@@@ Using your password, you can update the details above (if you have changed them), confirm or renew your entry (to stop it expiring), and view the full details, including any hidden email address:
-Password: -@@@endif:@@@ - -@@@if:fulldetails|updated@@@ - -Password: supplied. @@@endif:@@@ -@@@if:details|created|updated@@@ -
+@@@if:details|justcreated|justupdated@@@ + @@@endif:@@@ -@@@if:details|fulldetails|created|updated@@@ +@@@if:details|fulldetails|justcreated|justupdated@@@ +
+@@@endif:@@@ + +@@@if:details|justcreated@@@ +Password: +@@@endif:@@@ + +@@@if:fulldetails|justupdated@@@ + +Password: supplied. @@@endif:@@@
@@ -272,67 +343,59 @@ from @@@endif:@@@ -@@@if:notfound@@@ -Sorry, the database entry cannot be found. Perhaps the entry has been -deleted or expired. -

- -If you believe that this has happened to you in error, contact the -registry administrator, @@@adminemail@@@, quoting identifier @@@id@@@. - -@@@endif:@@@ - - -@@@if:view@@@ +@@@if:list@@@

View database

+ -@@@ifnot:viewingall@@@ +@@@ifnot:listingall@@@ - + @@@endif:@@@

Entries allocated from

+
    @@@foreach:area@@@ -@@@ifnot:area_viewing@@@ - +
  • +@@@ifnot:area_listing@@@ +@@@area@@@ @@@endif:@@@ -@@@if:area_viewing@@@ +@@@if:area_listing@@@ @@@area@@@ @@@endif:@@@ -
    @@@endforeach:@@@ +
@@@endif:@@@ -@@@if:view@@@ +@@@if:list@@@

Entries overlapping with

- - + +
@@@endif:@@@ -@@@if:viewingall|viewingoverlap|viewingarea@@@ +@@@if:listingall|listingarea|listingoverlap@@@

Database

-@@@if:viewingall@@@ +@@@if:listingall@@@ Entire database @@@endif:@@@ -@@@if:viewingoverlap@@@ -Entries which overlap with @@@viewoverlap@@@ +@@@if:listingoverlap@@@ +Entries which overlap with @@@listoverlap@@@ @@@endif:@@@ -@@@if:viewingarea@@@ -Database for entries allocated from @@@viewarea@@@ +@@@if:listingarea@@@ +Database for entries allocated from @@@listarea@@@ @@@endif:@@@

@@ -341,6 +404,8 @@ The range picked for you has been emphasized below. @@@endif:@@@

+@@@ifnot:listingnonefound@@@ + You can get details about an existing entry by clicking on its address range; this can also be used to modify it. @@ -348,7 +413,7 @@ range; this can also be used to modify it. Range Name Contact email
@@@foreach:db@@@ -@@@db_net@@@ +@@@db_net@@@ @@@db_name@@@ @@@db_email@@@
@@ -357,6 +422,12 @@ range; this can also be used to modify it. @@@endif:@@@ +@@@if:listingnonefound@@@ +There are no matching entries in the database. +@@@endif:@@@ + +@@@endif:@@@ + @@@eof:@@@