t.html
list
+pwkeys
lockfile
debug.txt
require 'config.pl';
require 'database.pl';
require 'utils.pl';
+require 'networks.pl';
+require 'listdb.pl';
+require 'passwords.pl';
if ($invokestyle ne 'manual') {
lock_database();
$fulldetails= 0;
$justcreated= 0;
$justupdated= 0;
+$needrenew= 0;
$picked= 0;
$listingall= 0;
$passwordsent= 0;
read_database();
get_entry();
+ show_entry();
$passwordsent= 1;
send_password();
} elsif (length $in{'id'}) {
- read_database();
- get_entry();
- $details= 1;
- show_entry();
- $list= 1;
- finish();
+ if (length $in{'pw'}) {
+
+ read_database();
+ get_entry();
+ check_password();
+ $ent->{'changed'}= $now;
+
+ $justupdated= 1;
+ show_entry();
+ finish();
+
+ } else {
+
+ read_database();
+ get_entry();
+ $details= 1;
+ show_entry();
+ $list= 1;
+ finish();
+
+ }
} else {
}
-sub parse_netrange ($) {
- my ($net) = @_;
- my ($prefix,$network,@b,$b,$val,$mask);
-
- length $net or finish_error('nonet');
-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);
- }
- ($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";
- return ($network,$prefix,$val,$mask);
-}
-
-sub set_entry () {
- my ($v, $b, @b, $val, $mask);
- $net= $in{'net'};
-
- ($network,$prefix,$val,$mask) = parse_netrange($net);
-print DEBUG "set_entry parsed netrange $network $prefix\n";
- $current_areai= find_areai($network,$prefix);
-print DEBUG "$current_areai\n";
- $current_areai>=0 or finish_error("wrongnet");
-print DEBUG "ok\n";
-
- foreach $v (qw(name contact email)) {
- $$v= $in{$v} unless $v eq 'email';
- length $$v or finish_error("no$v");
- finish_error("badchar") unless $$v =~ m/^[ -\176\240\376]+$/; $$v= $&;
- }
- $hiddenemail= !!length $in{'hiddenemail'};
-
- foreach $k (qw(generation network prefix name contact email hiddenemail)) {
- $ent->{$k}= $$k;
- }
-
- write_database();
-}
-
sub find_areai ($$) {
my ($network,$prefix) = @_;
my ($i);
return -1;
}
-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;
-}
-
-sub get_mask ($) {
- my ($prefix) = @_;
- my ($m, $sh);
- $m= 0xffffffff;
- $sh= 32-$prefix;
- $sh2= 0;
- if ($sh>=16) { $sh2 += 16; $sh -= 16; }
- $m <<= $sh;
- $m <<= $sh2;
- return $m;
-};
-
-sub net_valuemask ($$) {
- my ($network,$prefix) = @_;
- return (hex($network), get_mask($prefix));
-}
-
sub get_entry () {
length $in{'id'} or die;
$id= $in{'id'};
$dk= "date$k";
$$dk= gmtime($$k)." GMT";
}
+ $alwaysemail= $email;
if ($ent->{'hiddenemail'} && !$justcreated && !$fulldetails && !$justupdated) {
$displayemail= 0;
$email= '';
$emailhidechecked= $ent->{'hiddenemail'} ? 'checked' : '';
}
-sub list_database ($) {
- my ($instyle) = @_;
- my ($t, $v, $k, $x);
-print DEBUG "ldb 0 $instyle\n";
- $instyle =~ m/all|area|overlap/ or die "$instyle ?";
- $listing= $&;
- &{"dblist_prep_$listing"}();
- @kl= ();
-print DEBUG "ldb 1 $v @kl\n";
- foreach $k (keys %db) {
-print DEBUG "ldb q $k\n";
- $ent= $db{$k};
- next unless &{"dblist_cond_$listing"};
- 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;
- $x= $db{$a}->{'contact'} cmp $db{$b}->{'contact'}; 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";
- $v= "listing$listing"; $$v= 1;
- $list= 1;
-}
-
sub check_generation () {
$ent->{'generation'} eq $ent->{'generation'} or finish_error('generation');
}
+sub set_entry () {
+ my ($v, $b, @b, $val, $mask);
+ $net= $in{'net'};
+
+ ($network,$prefix,$val,$mask) = parse_netrange($net);
+print DEBUG "set_entry parsed netrange $network $prefix\n";
+ $current_areai= find_areai($network,$prefix);
+print DEBUG "$current_areai\n";
+ $current_areai>=0 or finish_error("wrongnet");
+print DEBUG "ok\n";
+
+ foreach $v (qw(name contact email)) {
+ $$v= $in{$v} unless $v eq 'email';
+ length $$v or finish_error("no$v");
+ finish_error("badchar") unless $$v =~ m/^[ -\176\240\376]+$/; $$v= $&;
+ }
+ $hiddenemail= !!length $in{'hiddenemail'};
+
+ foreach $k (qw(generation network prefix name contact email hiddenemail)) {
+ $ent->{$k}= $$k;
+ }
+
+ write_database();
+}
+
sub pick_net () {
my ($ai, $k, $vn, $rand, $mask, $fixmask, $value);
my ($type) = @_;
my ($t, $esel, $f);
foreach $t (qw(noemail nonet noname nocontact badsize wrongsize badnet wrongnet
- notfound generation badchar)) {
+ nopassword badpassword notfound generation badchar)) {
$esel= "error_$t";
$$esel= 0;
$f=1 if $type eq $t;
exit 0;
}
-sub dblist_prep_all { }
-sub dblist_cond_all { 1; }
-
-sub dblist_prep_area {
- my ($network,$prefix);
- $network= $area_networks[$list_areai];
- $prefix= $area_prefixes[$list_areai];
- $listarea= display_net($network,$prefix);
- $dbl_mask= get_mask($prefix);
- $dbl_value= hex($network);
-}
-sub dblist_cond_area {
- my ($v, $r);
- $v= hex($ent->{'network'});
- $r= 1 if ($v & $dbl_mask) == $dbl_value;
-print DEBUG "dblist_cond_area $k $v $r\n";
- return $r;
-}
-
-sub dblist_prep_overlap {
- my ($network,$prefix);
- ($network,$prefix,$dbl_mask,$dbl_value) = parse_netrange($in{'with'});
- $listoverlap= display_net($network,$prefix);
-}
-sub dblist_cond_overlap {
- my ($v, $m);
- $v= hex($ent->{'network'});
- $m= get_mask($ent->{'prefix'});
- $m &= $dbl_mask;
- return ($v & $m) == ($dbl_value & $m);
-}
-
sub foreach_start_area { $area_i=0; }
sub foreach_cond_area { return $area_i < @area_networks; }
sub foreach_incr_area { $area_i++; }
$area_listing= $area_i eq $list_areai;
# out("<!-- setvars_area @area_networks $area_i $area $list_areai -->");
}
-
-%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 { $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};
- $db_picked= $k eq 'picked';
- if ($db_picked) {
- undef $db_id;
- } else {
- $db_id= $k;
- }
- $db_net= display_net($ent->{'network'}, $ent->{'prefix'});
- $db_name= html_sani($ent->{'name'});
- $db_contact= html_sani($ent->{'contact'});
- $db_email= $ent->{'hiddenemail'} ? "" : html_sani($ent->{'email'});
-}
$nameboxlen= 55;
$contactboxlen= 55;
$emailboxlen= 55;
-$cgi= 'http://www.chiark.greenend.org.uk/ucgi/~ijackson/bcp5-registry.pl';
+$nullemail= 'discard-all@chiark.greenend.org.uk';
+$cgi= 'http://www.chiark.greenend.org.uk/ucgi/~ijackson/cam-g-rin';
$ENV{'PATH'}= '/usr/local/bin:/bin:/usr/bin';
--- /dev/null
+#
+
+sub list_database ($) {
+ my ($instyle) = @_;
+ my ($t, $v, $k, $x);
+print DEBUG "ldb 0 $instyle\n";
+ $instyle =~ m/all|area|overlap/ or die "$instyle ?";
+ $listing= $&;
+ &{"dblist_prep_$listing"}();
+ @kl= ();
+print DEBUG "ldb 1 $v @kl\n";
+ foreach $k (keys %db) {
+print DEBUG "ldb q $k\n";
+ $ent= $db{$k};
+ next unless &{"dblist_cond_$listing"};
+ 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;
+ $x= $db{$a}->{'contact'} cmp $db{$b}->{'contact'}; 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";
+ $v= "listing$listing"; $$v= 1;
+ $list= 1;
+}
+
+sub dblist_prep_all { }
+sub dblist_cond_all { 1; }
+
+sub dblist_prep_area {
+ my ($network,$prefix);
+ $network= $area_networks[$list_areai];
+ $prefix= $area_prefixes[$list_areai];
+ $listarea= display_net($network,$prefix);
+ $dbl_mask= get_mask($prefix);
+ $dbl_value= hex($network);
+}
+sub dblist_cond_area {
+ my ($v, $r);
+ $v= hex($ent->{'network'});
+ $r= 1 if ($v & $dbl_mask) == $dbl_value;
+print DEBUG "dblist_cond_area $k $v $r\n";
+ return $r;
+}
+
+sub dblist_prep_overlap {
+ my ($network,$prefix);
+ ($network,$prefix,$dbl_mask,$dbl_value) = parse_netrange($in{'with'});
+ $listoverlap= display_net($network,$prefix);
+}
+sub dblist_cond_overlap {
+ my ($v, $m);
+ $v= hex($ent->{'network'});
+ $m= get_mask($ent->{'prefix'});
+ $m &= $dbl_mask;
+ return ($v & $m) == ($dbl_value & $m);
+}
+
+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};
+ $db_picked= $k eq 'picked';
+ if ($db_picked) {
+ undef $db_id;
+ } else {
+ $db_id= $k;
+ }
+ $db_net= display_net($ent->{'network'}, $ent->{'prefix'});
+ $db_name= html_sani($ent->{'name'});
+ $db_contact= html_sani($ent->{'contact'});
+ $db_email= $ent->{'hiddenemail'} ? "" : html_sani($ent->{'email'});
+}
+
+1;
--- /dev/null
+#
+
+sub parse_netrange ($) {
+ my ($net) = @_;
+ my ($prefix,$network,@b,$b,$val,$mask);
+
+ length $net or finish_error('nonet');
+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);
+ }
+ ($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";
+ return ($network,$prefix,$val,$mask);
+}
+
+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;
+}
+
+sub get_mask ($) {
+ my ($prefix) = @_;
+ my ($m, $sh);
+ $m= 0xffffffff;
+ $sh= 32-$prefix;
+ $sh2= 0;
+ if ($sh>=16) { $sh2 += 16; $sh -= 16; }
+ $m <<= $sh;
+ $m <<= $sh2;
+ return $m;
+};
+
+sub net_valuemask ($$) {
+ my ($network,$prefix) = @_;
+ return (hex($network), get_mask($prefix));
+}
+
+sub display_net ($$) {
+ my ($network,$prefix) = @_;
+ return join('.', unpack("C4",pack("H8",$network)))."/".$prefix;
+}
+
+1;
--- /dev/null
+From: "@@@adminname@@@" (@@@whose@@@ G-RIN administrator) <@@@adminemail@@@>
+To: "@@@name@@@" <@@@email@@@>
+
+@@@if:justcreated@@@
+Subject: G-RIN entry @@@net@@@ created, please confirm
+@@@
+The following new database entry has been created for or by you at the
+@@@whose@@@ G-RIN (Geeks' Internet Registry):
+@@@endif:@@@
+
+@@@if:passwordsent@@@
+Subject: G-RIN entry @@@net@@@ password
+@@@
+You (or someone acting on your behalf) asked for the password to be
+mailed out for the following entry in the @@@whose@@@ G-RIN:
+@@@endif:@@@
+
+@@@if:needrenew@@@
+Subject: G-RIN entry @@@net@@@ renewal
+@@@
+The following database entry in the @@@whose@@@ G-RIN
+is now due for renewal. It will be discarded from the database in few
+weeks if you do not confirm it before then.
+@@@endif:@@@
+
+ Network: @@@net@@@
+ Name: @@@name@@@
+ Contact: @@@contact@@@
+ Email: @@@alwaysemail@@@
+@@@if:hiddenemail@@@
+ Email address hidden from public database
+@@@endif:@@@
+@@@ifnot:hiddenemail@@@
+ Email address visible in public database
+@@@endif:@@@
+@@@
+ The password for this entry is: @@@password@@@
+@@@
+
+@@@if:justcreated@@@
+Currently this is only a temporary entry. It must be confirmed if it
+is to persist in the database. You may confirm it by using the G-RIN
+web page that was used to register it (and supplying the password),
+or you may simply visit the following URL for instant confirmation:
+@@@endif:@@@
+
+@@@if:needrenew@@@
+You may renew it by using the G-RIN web page or you may simply visit
+the following URL for instant renewal:
+@@@endif:@@@
+
+@@@if:justcreated|needrenew@@@
+ @@@cgi@@@?id=@@@id@@@&pw=@@@password@@@
+@@@endif:@@@
+
+@@@if:passwordsent@@@
+You may modify this entry via the G-RIN web page, or you may go
+directly to the view/update page for this entry:
+ @@@cgi@@@?view=1&id=@@@id@@@&pw=@@@password@@@
+@@@endif:@@@
+
+@@@if:justcreated@@@
+@@@
+
+If you do not know why you received this email it is possible that
+someone is playing tricks on you, by (for example), entering your
+email address instead of their own, at the G-RIN web page. If so you
+can safely ignore this message; the database entry will expire in a
+few days and you will not be bothered any more. If you wish to try to
+trace the perpetrator the G-RIN administrator may have some more
+information.
+@@@endif:@@@
+
+Thank you for your use of the @@@whose@@@ G-RIN. Please contact
+me if you have any problems.
+
+@@@
+
+@@@adminname@@@
+<@@@adminemail@@@>
+administrator, @@@whose@@@ G-RIN
+@@@cgi@@@
+(Geeks' Registry of Internet Numbers - BCP5 (RFC1918) registry)
+@@@eof:@@@
--- /dev/null
+#
+
+use MD5;
+
+sub check_password () {
+ my ($pw);
+ $password= $in{'pw'};
+ length $password or finish_error('nopassword');
+ defined $ent or die;
+
+ open P,"pwkeys" or die $!;
+ for (;;) {
+ $_= <P>; die $! unless length; chomp;
+ finish_error('badpassword') if m/^end$/;
+ $pw= calc_password($_,$id);
+ last if lc $pw eq lc $password
+ }
+ close P;
+}
+
+sub calc_password ($$) {
+ my ($keyhex,$id) = @_;
+ # keys are hex-encoded octet strings; ids are just ASCII strings
+ my ($key);
+
+ $keyhex =~ m/^[0-9a-f]+$/ or die "$keyhex ?";
+ $key= pack('H*',$keyhex);
+ $digest= MD5->hash("BCP5Registry password 1 $id ".$key);
+ return unpack('H20',$digest);
+}
+
+sub make_password ($) {
+ my ($keyhex,$pw);
+
+ open P,"pwkeys" or die $!;
+ $keyhex= <P>; $keyhex =~ s/\n$// or die $!;
+ $pw= calc_password($keyhex,$id);
+ close P;
+ return $pw;
+}
+
+sub send_password ($) {
+ $password= make_password($id);
+ process_file('notice.txt');
+ print DEBUG "---\n$out---\n";
+}
+
+1;
password sent for @@@name@@@
@@@endif:@@@
-@@@if:details@@@
+@@@if:details|fulldetails@@@
details of @@@name@@@
@@@endif:@@@
Random network picked: @@@net@@@
@@@endif:@@@
-@@@if:details@@@
+@@@if:details|fulldetails@@@
Database entry details: @@@name@@@
@@@endif:@@@
Database entry updated: @@@name@@@
@@@endif:@@@
+@@@if:passwordsent@@@
+Password sent
+@@@endif:@@@
+
@@@if:listingall@@@
Entire database listing
@@@endif:@@@
You must provide a contact name.
@@@endif:@@@
+@@@if:error_nopassword@@@
+You must supply the password.
+@@@endif:@@@
+
+@@@if:error_badpassword@@@
+The password you supplied was not correct. Please supply the correct
+password. If you do not know the password, ask to have it mailed to
+you.
+@@@endif:@@@
+
@@@if:error_nonet@@@
You must provide a network number !
@@@endif:@@@
<h2>Entry details</h2>
@@@endif:@@@
+@@@if:passwordsent@@@
+The password for this database entry has been mailed to the recorded
+contact email address.
+
+<h2>Entry details</h2>
+@@@endif:@@@
+
@@@if:justcreated@@@
<h2>Entry created</h2>
@@@endif:@@@
-@@@if:registernew|details|fulldetails|justcreated|justupdated|picked@@@
+@@@if:registernew|details|fulldetails|justcreated|justupdated|picked|passwordsent@@@
<p>
<form method="POST" action="@@@cgi@@@">
<input type=submit name="register" value="Register.">
@@@endif:@@@
-@@@if:details|fulldetails|justcreated|justupdated@@@
+@@@if:details|fulldetails|justcreated|justupdated|passwordsent@@@
<p>
Entry created: @@@datecreated@@@<br>
@@@endif:@@@
-@@@if:details|fulldetails|justcreated|justupdated@@@
+@@@if:details|fulldetails|justcreated|justupdated|passwordsent@@@
<h3>Modify or manage this entry</h3>
@@@endif:@@@
-@@@if:details|justcreated@@@
+@@@if:details|justcreated|passwordsent@@@
Using your password, you can update the details above (if you have
changed them) and confirm or renew your entry (to stop it expiring).
@@@ifnot:displayemail@@@
<input type=submit name="view" value="View full details.">
@@@endif:@@@
-@@@if:details|fulldetails|justcreated|justupdated@@@
+@@@if:details|fulldetails|justcreated|justupdated|passwordsent@@@
<input type=submit name="update" value="Update/confirm/renew.">
<input type=submit name="delete" value="Delete.">
<br>
@@@endif:@@@
-@@@if:details|justcreated@@@
-Password: <input type=text name="password" size="30">
+@@@if:details|justcreated|passwordsent@@@
+Password: <input type=text name="pw" size="30">
@@@endif:@@@
@@@if:fulldetails|justupdated@@@
-<input type=hidden name="password" value="@@@password@@@">
+<input type=hidden name="pw" value="@@@password@@@">
Password: supplied.
@@@endif:@@@
process(1);
}
-sub display_net ($$) {
- my ($network,$prefix) = @_;
- return join('.', unpack("C4",pack("H8",$network)))."/".$prefix;
-}
-
sub randnybs ($) {
my ($nybbles) = @_;
my ($v, $r, $bytes);
}
process(0);
} elsif (m/\S/) {
+ s/^\@\@\@$//;
if ($doing) {
s/\@\@\@(\w+)\@\@\@/ getvar("$1") /ge;
out($_);
return $$vn;
}
+%saniarray= ('<','lt', '>','gt', '&','amp', '"','quot');
+sub html_sani {
+ local ($in) = @_;
+ local ($out);
+ while ($in =~ m/[<>&"]/) {
+ $out.= $`. '&'. $saniarray{$&}. ';';
+ $in=$';
+ }
+ $out.= $in;
+ $out;
+}
+
1;
~ijackson / bcp5-registry.git / commitdiff