bcp5-registry.pl

   1 #!/usr/bin/perl
   2 # Main G-RIN CGI script code.  Must be invoked with --cgi if
   3 # as a CGI script - see the example file cam-grin.
   4 #
   5 # Copyright (C) 1999 Ian Jackson <ijackson@chiark.greenend.org.uk>
   6 #
   7 # This is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as
   9 # published by the Free Software Foundation; either version 2,
  10 # or (at your option) any later version.
  11 #
  12 # This is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public
  18 # License along with this file; if not, write to the Free Software
  19 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21 use POSIX;
  22
  23 @org_argv= @ARGV;
  24 $needrenew= 0;
  25
  26 if ($ARGV[0] eq '--cgi') {
  27     shift @ARGV;
  28     $invokestyle= 'cgi';
  29 } elsif ($ARGV[0] eq '--expire-noconfirm') {
  30     shift @ARGV;
  31     $invokestyle= 'maintain';
  32 } elsif ($ARGV[0] eq '--expire-norenew') {
  33     shift @ARGV;
  34     $invokestyle= 'maintain';
  35     $needrenew= 1;
  36 } elsif ($ARGV[0] =~ m/^--/) {
  37     die "$ARGV[0] ?";
  38 } elsif ($ENV{'SERVER_SOFTWARE'} =~ m/^Lynx/) {
  39     $invokestyle= 'lynxcgi';
  40 } else {
  41     $invokestyle= 'manual';
  42 }
  43
  44 if ($invokestyle eq 'manual') {
  45     open DEBUG,">&STDERR" or die $!;
  46 } elsif ($invokestyle eq 'lynxcgi') {
  47     open DEBUG,">>debug.txt" or die $!;
  48 } elsif ($invokestyle eq 'cgi' || $invokestyle eq 'maintain') {
  49     open DEBUG,">/dev/null" or die $!;
  50 }
  51
  52 if ($invokestyle eq 'cgi' || $invokestyle eq 'maintain') {
  53     $scriptdir= shift @ARGV;
  54     $datadir= shift @ARGV;
  55 } else {
  56     $scriptdir= '.';
  57     $datadir= '.';
  58 }
  59
  60 if (!($invokestyle eq 'manual' || $invokestyle eq 'maintain')) {
  61     $ct= 'BCP5REGISTRY_CONTENTTYPEDONE';
  62     if (!$ENV{$ct}) {
  63         $|=1;
  64         print "Content-Type: text/html\n\n" or die $!;
  65         $|=0;
  66         $ENV{$ct}= 1;
  67     }
  68 }
  69
  70 push @INC,$scriptdir;
  71 chdir($datadir) or die $!;
  72
  73 require 'config.pl';
  74 require 'database.pl';
  75 require 'utils.pl';
  76 require 'networks.pl';
  77 require 'listdb.pl';
  78 require 'passwords.pl';
  79
  80 if (!($invokestyle eq 'manual' || $invokestyle eq 'maintain')) {
  81     lock_database();
  82     require 'cgi-lib.pl';
  83     &ReadParse;
  84     foreach $k (keys %in) { print DEBUG "$k -> \"$in{$k}\"\n"; }
  85 } else {
  86     foreach $x (@ARGV) {
  87         $x =~ m/^(\w+)\=/ or die "$x ?";
  88         $in{$1}= $';
  89         print DEBUG "$1 -> \"$'\"\n";
  90     }
  91 }
  92
  93 if ($invokestyle eq 'lynxcgi') {
  94     defined($pwd= getcwd) or die $!;
  95     $_= $0; s,^.*/,,;
  96     $cgi= "lynxcgi:$pwd/$_";
  97 }
  98
  99 @area_networks= qw(0a000000 ac100000 c0a80000);
 100 @area_prefixes= qw(8 12 16);
 101 $rec_areai= 1;
 102
 103 $current_areai= $rec_areai;
 104 $list_areai= '';
 105 $listoverlap= '';
 106
 107 $listing= '';
 108 $intro= 0;
 109 $error= 0;
 110 $registernew= 0;
 111 $pick= 0;
 112 $deleted= 0;
 113 $pickvarsubnet= 8;
 114 $pickvarprefix= 24;
 115 $pick28check= '';
 116 $pick24check= 'checked';
 117 $pickvarsubnetcheck= '';
 118 $pickvarprefixcheck= '';
 119 $details= 0;
 120 $fulldetails= 0;
 121 $justcreated= 0;
 122 $justupdated= 0;
 123 $picked= 0;
 124 $listingall= 0;
 125 $passwordsent= 0;
 126 $list= 0;
 127 $notfound= 0;
 128 $id= '';
 129 $name= '';
 130 $contact= '';
 131 $email= '';
 132 $net= '';
 133 $emailhidechecked= '';
 134 $hiddenemail= 0;
 135
 136 $listingarea= length $list_areai;
 137 $listingoverlap= length $listoverlap;
 138
 139 defined($now= time) or die $!;
 140
 141 if ($invokestyle eq 'maintain') {
 142
 143     lock_database();
 144     read_database();
 145
 146     if ($needrenew) {
 147         $threshold_recent= $now - $renew_interval;
 148         $threshold_old= $threshold_recent - $expire_norenew;
 149     } else {
 150         $threshold= $now - $expire_noconfirm;
 151     }
 152
 153     $changed= 0;
 154
 155     foreach $id (keys %db) {
 156         $ent= $db{$id};
 157         if ($needrenew) {
 158             next unless $ent->{'changed'};
 159             next if $ent->{'changed'} >= $threshold_recent;
 160             if ($ent->{'changed'} > $threshold_old) {
 161                 show_entry();
 162                 send_password();
 163                 print "sent renewal for $id ($net)\n" or die $!;
 164                 next;
 165             }
 166             show_entry();
 167             printf("deleted stale %s (%s, %x %x %x)\n",
 168                    $id, $net, $threshold_recent, $threshold_old,
 169                    $ent->{'changed'}) or die $!;
 170         } else {
 171             next if $ent->{'changed'};
 172             next if $ent->{'created'} >= $threshold;
 173             show_entry();
 174             printf("deleted new %s (%s, %x %x)\n",
 175                    $id, $net, $threshold, $ent->{'created'}) or die $!;
 176         }
 177         delete $db{$id};
 178         $changed= 1;
 179     }
 180
 181     if ($changed) {
 182         write_database();
 183     }
 184     close STDOUT or die $!;
 185     exit 0;
 186
 187 } elsif (length $in{'register'}) {
 188
 189     lock_database();
 190     read_database();
 191
 192     $id= randnybs(16);
 193     $db{$id}= $ent= { };
 194     $ent->{'created'}= $now;
 195     $ent->{'changed'}= 0;
 196     $alwaysemail= $email= $in{'email'};
 197     set_entry();
 198
 199     $justcreated= 1;
 200     send_password();
 201
 202     show_entry();
 203     finish();
 204
 205 } elsif (length $in{'mailpasswd'}) {
 206
 207     read_database();
 208     get_entry();
 209     show_entry();
 210
 211     $passwordsent= 1;
 212     send_password();
 213
 214     finish();
 215
 216 } elsif (length $in{'view'}) {
 217
 218     read_database();
 219     get_entry();
 220     check_password();
 221
 222     $fulldetails= 1;
 223     show_entry();
 224     finish();
 225
 226 } elsif (length $in{'update'}) {
 227
 228     lock_database();
 229     read_database();
 230     get_entry();
 231     check_password();
 232
 233     $ent->{'changed'}= $now;
 234     $email= length($in{'email'}) ? $in{'email'} : $db{$id}->{'email'};
 235     set_entry();
 236
 237     $justupdated= 1;
 238     show_entry();
 239     finish();
 240
 241 } elsif (length $in{'delete'}) {
 242
 243     lock_database();
 244     read_database();
 245     get_entry();
 246     check_password();
 247
 248     $deleted= 1;
 249     show_entry();
 250
 251     delete $db{$id};
 252     write_database();
 253
 254     finish();
 255
 256 } elsif (length $in{'pick'}) {
 257
 258     read_database();
 259     pick_net();
 260     $picked= 1;
 261     $pick= 1;
 262     $list= 1;
 263     $listoverlap= $net;
 264     finish();
 265
 266 } elsif (length $in{'list'}) {
 267
 268     read_database();
 269     $list_areai= $in{'listareai'};
 270     list_database($in{'list'});
 271     finish();
 272
 273 } elsif (length $in{'id'}) {
 274
 275     if (length $in{'pw'}) {
 276
 277         read_database();
 278         get_entry();
 279         check_password();
 280         $ent->{'changed'}= $now;
 281
 282         $justupdated= 1;
 283         show_entry();
 284         finish();
 285
 286     } else {
 287
 288         read_database();
 289         get_entry();
 290         $details= 1;
 291         show_entry();
 292         $list= 1;
 293         finish();
 294
 295     }
 296
 297 } else {
 298
 299     $intro= 1;
 300     $list= 1;
 301     $pick= 1;
 302     $displayemail= 1;
 303     $registernew= 1;
 304     finish();
 305
 306 }
 307
 308 sub find_areai ($$) {
 309     my ($network,$prefix) = @_;
 310     my ($i);
 311     for ($i=0; $i<@area_networks; $i++) {
 312         next unless net_subset($network,$prefix, $area_networks[$i],$area_prefixes[$i]);
 313         return $i;
 314     }
 315     return -1;
 316 }
 317
 318 sub get_entry () {
 319     length $in{'id'} or die;
 320     $id= $in{'id'};
 321     exists $db{$id} or finish_error('notfound');
 322     $ent= $db{$id};
 323 }
 324
 325 sub show_entry () {
 326     my ($k, $dk);
 327     foreach $k (@db_fields) {
 328         $$k= $ent->{$k};
 329     }
 330     foreach $k (qw(created changed)) {
 331         $dk= "date$k";
 332         $$dk= gmtime($$k)." GMT";
 333     }
 334     $alwaysemail= $email;
 335     if ($ent->{'hiddenemail'} && !$justcreated && \
 336                !$fulldetails && !$justupdated && !$deleted) {
 337         $displayemail= 0;
 338         $email= '';
 339     } else {
 340         $displayemail= 1;
 341     }
 342     $net= display_net($network,$prefix);
 343     $emailhidechecked= $ent->{'hiddenemail'} ? 'checked' : '';
 344     $listoverlap= $net;
 345 }
 346
 347 sub set_entry () {
 348     my ($v, $b, @b, $val, $mask);
 349     $net= $in{'net'};
 350
 351     ($network,$prefix,$val,$mask) = parse_netrange($net);
 352 print DEBUG "set_entry parsed netrange $network $prefix\n";
 353     $current_areai= find_areai($network,$prefix);
 354 print DEBUG "$current_areai\n";
 355     $current_areai>=0 or finish_error("wrongnet");
 356 print DEBUG "ok\n";
 357
 358     foreach $v (qw(name contact email)) {
 359         $$v= $in{$v} unless $v eq 'email';
 360         length $$v or finish_error("no$v");
 361         finish_error("badchar") unless $$v =~ m/^[ -\176\240\376]+$/; $$v= $&;
 362     }
 363     $hiddenemail= !!length $in{'hiddenemail'};
 364
 365     foreach $k (qw(network prefix name contact email hiddenemail)) {
 366         $ent->{$k}= $$k;
 367     }
 368
 369     write_database();
 370 }
 371
 372 sub pick_net () {
 373     my ($ai, $k, $vn, $rand, $mask, $fixmask, $value);
 374
 375     $ai= $in{'from'}; $ai =~ m/\d+/ or die "$ai ?"; $ai= $&;
 376     ($ai>=0 && $ai<@area_networks) or die "$ai ?";
 377     $current_areai= $ai;
 378
 379     foreach $k (qw(24 28 prefix subnet)) { $vn= "pick${k}check"; $$vn= ''; }
 380     foreach $k (qw(prefix subnet)) { $vn= "pickvar${k}"; $$vn= $in{$vn}; }
 381
 382     $_= $in{'specsize'};
 383     if (m/\d+/) {
 384         $specsize= $&+0;
 385         $vn= "pick${specsize}check"; $$vn= 'checked';
 386     } elsif (m/prefix|subnet/) {
 387         $which= $&;
 388         $vn= "pickvar${which}check"; $$vn= 'checked';
 389         $specsize= $in{"pickvar${which}"};
 390         $specsize =~ m/\d+/ or finish_error('badsize');
 391         $specsize= $&+0;
 392         ($specsize >= 0 && $specsize <= 32) or finish_error('badsize');
 393         $specsize= 32-$specsize if $which eq 'subnet';
 394     } else {
 395         die "$_ ?";
 396     }
 397
 398     $network= $area_networks[$ai];
 399     $prefix= $area_prefixes[$ai];
 400     $net= display_net($network,$prefix);
 401     ($specsize >= $prefix) or finish_error('wrongsize');
 402
 403     $fixmask= get_mask($prefix);
 404     $mask= get_mask($specsize);
 405     $rnybs= randnybs(8);
 406     $rand= hex($rnybs);
 407     $value= hex($network) | ($rand & ($mask & ~$fixmask));
 408     $vhex= sprintf '%08x',$value;
 409
 410     $net= display_net($vhex,$specsize);
 411     $displayemail= 1;
 412
 413 printf DEBUG "picking network=$network prefix=$prefix net=$net specsize=$specsize\n";
 414 printf DEBUG "picking rnybs=%s fixmask=%08x mask=%08x rand=%08x ".
 415     "value=%08x vhex=%s net=%s\n",
 416     $rnybs,$fixmask,$mask,$rand,$value,$vhex,$net;
 417
 418     $ent= { };
 419     $db{'picked'}= $ent;
 420     $ent->{'network'}= $vhex;
 421     $ent->{'prefix'}= $specsize;
 422     $list_areai= $ai;
 423     list_database('area');
 424 }
 425
 426 sub finish_error ($) {
 427     my ($type) = @_;
 428     my ($t, $esel, $f);
 429     foreach $t (qw(noemail nonet noname nocontact badsize wrongsize badnet wrongnet
 430                    nopassword badpassword notfound badchar)) {
 431         $esel= "error_$t";
 432         $$esel= 0;
 433         $f=1 if $type eq $t;
 434     }
 435     die $type unless $f;
 436     $esel= "error_$type";
 437     $$esel= 1;
 438     $error= 1;
 439     finish();
 440 }
 441
 442 sub finish () {
 443     process_file('template.html');
 444     print $out or die $!;
 445     close STDOUT or die $!;
 446     exit 0;
 447 }
 448
 449 sub foreach_start_area { $area_i=0; }
 450 sub foreach_cond_area { return $area_i < @area_networks; }
 451 sub foreach_incr_area { $area_i++; }
 452 sub foreach_setvars_area {
 453     $area_network= $area_networks[$area_i];
 454     $area= display_net($area_network,$area_prefixes[$area_i]);
 455     $area_recommended= $area_i==$rec_areai;
 456     $area_pickchecked= $area_i==$current_areai ? 'checked' : '';
 457     $area_listing= $area_i eq $list_areai;
 458 #    out("<!-- setvars_area @area_networks $area_i $area $list_areai -->");
 459 }