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 $listingviewoverlap= 0;
 126 $passwordsent= 0;
 127 $list= 0;
 128 $notfound= 0;
 129 $id= '';
 130 $name= '';
 131 $contact= '';
 132 $email= '';
 133 $net= '';
 134 $emailhidechecked= '';
 135 $hiddenemail= 0;
 136
 137 $listingarea= length $list_areai;
 138 $listingoverlap= length $listoverlap;
 139
 140 defined($now= time) or die $!;
 141
 142 if ($invokestyle eq 'maintain') {
 143
 144     lock_database();
 145     read_database();
 146
 147     if ($needrenew) {
 148         $threshold_recent= $now - $renew_interval;
 149         $threshold_old= $threshold_recent - $expire_norenew;
 150     } else {
 151         $threshold= $now - $expire_noconfirm;
 152     }
 153
 154     $changed= 0;
 155
 156     foreach $id (keys %db) {
 157         $ent= $db{$id};
 158         if ($needrenew) {
 159             next unless $ent->{'changed'};
 160             next if $ent->{'changed'} >= $threshold_recent;
 161             if ($ent->{'changed'} > $threshold_old) {
 162                 show_entry();
 163                 send_password();
 164                 print "sent renewal for $id ($net)\n" or die $!;
 165                 next;
 166             }
 167             show_entry();
 168             printf("deleted stale %s (%s, %x %x %x)\n",
 169                    $id, $net, $threshold_recent, $threshold_old,
 170                    $ent->{'changed'}) or die $!;
 171         } else {
 172             next if $ent->{'changed'};
 173             next if $ent->{'created'} >= $threshold;
 174             show_entry();
 175             printf("deleted new %s (%s, %x %x)\n",
 176                    $id, $net, $threshold, $ent->{'created'}) or die $!;
 177         }
 178         delete $db{$id};
 179         $changed= 1;
 180     }
 181
 182     if ($changed) {
 183         write_database();
 184     }
 185     close STDOUT or die $!;
 186     exit 0;
 187
 188 } elsif (length $in{'register'}) {
 189
 190     lock_database();
 191     read_database();
 192
 193     $id= randnybs(16);
 194     $db{$id}= $ent= { };
 195     $ent->{'created'}= $now;
 196     $ent->{'changed'}= 0;
 197     $alwaysemail= $email= $in{'email'};
 198     set_entry();
 199
 200     $justcreated= 1;
 201     send_password();
 202
 203     show_entry();
 204     finish();
 205
 206 } elsif (length $in{'mailpasswd'}) {
 207
 208     read_database();
 209     get_entry();
 210     show_entry();
 211
 212     $passwordsent= 1;
 213     send_password();
 214
 215     finish();
 216
 217 } elsif (length $in{'view'}) {
 218
 219     read_database();
 220     get_entry();
 221     check_password();
 222
 223     $fulldetails= 1;
 224     show_entry();
 225     finish();
 226
 227 } elsif (length $in{'update'}) {
 228
 229     lock_database();
 230     read_database();
 231     get_entry();
 232     check_password();
 233
 234     $ent->{'changed'}= $now;
 235     $email= length($in{'email'}) ? $in{'email'} : $db{$id}->{'email'};
 236     set_entry();
 237
 238     $justupdated= 1;
 239     show_entry();
 240     finish();
 241
 242 } elsif (length $in{'delete'}) {
 243
 244     lock_database();
 245     read_database();
 246     get_entry();
 247     check_password();
 248
 249     $deleted= 1;
 250     show_entry();
 251
 252     delete $db{$id};
 253     write_database();
 254
 255     finish();
 256
 257 } elsif (length $in{'pick'}) {
 258
 259     read_database();
 260     pick_net();
 261     $picked= 1;
 262     $pick= 1;
 263     $list= 1;
 264     $listoverlap= $net;
 265     finish();
 266
 267 } elsif (length $in{'list'}) {
 268
 269     read_database();
 270     $list_areai= $in{'listareai'};
 271     list_database($in{'list'});
 272     finish();
 273
 274 } elsif (length $in{'id'}) {
 275
 276     if (length $in{'pw'}) {
 277
 278         read_database();
 279         get_entry();
 280         check_password();
 281         $ent->{'changed'}= $now;
 282
 283         $justupdated= 1;
 284         show_entry();
 285         write_database();
 286         finish();
 287
 288     } else {
 289
 290         read_database();
 291         get_entry();
 292         $details= 1;
 293         show_entry();
 294         $list= 1;
 295         finish();
 296
 297     }
 298
 299 } else {
 300
 301     $intro= 1;
 302     $list= 1;
 303     $pick= 1;
 304     $displayemail= 1;
 305     $registernew= 1;
 306     finish();
 307
 308 }
 309
 310 sub find_areai ($$) {
 311     my ($network,$prefix) = @_;
 312     my ($i);
 313     for ($i=0; $i<@area_networks; $i++) {
 314         next unless net_subset($network,$prefix, $area_networks[$i],$area_prefixes[$i]);
 315         return $i;
 316     }
 317     return -1;
 318 }
 319
 320 sub get_entry () {
 321     length $in{'id'} or die;
 322     $id= $in{'id'};
 323     exists $db{$id} or finish_error('notfound');
 324     $ent= $db{$id};
 325 }
 326
 327 sub show_entry () {
 328     my ($k, $dk);
 329     foreach $k (@db_fields) {
 330         $$k= $ent->{$k};
 331     }
 332     foreach $k (qw(created changed)) {
 333         $dk= "date$k";
 334         $$dk= gmtime($$k)." GMT";
 335     }
 336     $alwaysemail= $email;
 337     if ($ent->{'hiddenemail'} && !$justcreated && \
 338                !$fulldetails && !$justupdated && !$deleted) {
 339         $displayemail= 0;
 340         $email= '';
 341     } else {
 342         $displayemail= 1;
 343     }
 344     $net= display_net($network,$prefix);
 345     $emailhidechecked= $ent->{'hiddenemail'} ? 'checked' : '';
 346     list_database('viewoverlap');
 347 }
 348
 349 sub set_entry () {
 350     my ($v, $b, @b, $val, $mask);
 351     $net= $in{'net'};
 352
 353     ($network,$prefix,$val,$mask) = parse_netrange($net);
 354 print DEBUG "set_entry parsed netrange $network $prefix\n";
 355     $current_areai= find_areai($network,$prefix);
 356 print DEBUG "$current_areai\n";
 357     $current_areai>=0 or finish_error("wrongnet");
 358 print DEBUG "ok\n";
 359
 360     foreach $v (qw(name contact email)) {
 361         $$v= $in{$v} unless $v eq 'email';
 362         length $$v or finish_error("no$v");
 363         finish_error("badchar") unless $$v =~ m/^[ -\176\240\376]+$/; $$v= $&;
 364     }
 365     $hiddenemail= !!length $in{'hiddenemail'};
 366
 367     foreach $k (qw(network prefix name contact email hiddenemail)) {
 368         $ent->{$k}= $$k;
 369     }
 370
 371     write_database();
 372 }
 373
 374 sub pick_net () {
 375     my ($ai, $k, $vn, $rand, $mask, $fixmask, $value);
 376
 377     $ai= $in{'from'}; $ai =~ m/\d+/ or die "$ai ?"; $ai= $&;
 378     ($ai>=0 && $ai<@area_networks) or die "$ai ?";
 379     $current_areai= $ai;
 380
 381     foreach $k (qw(24 28 prefix subnet)) { $vn= "pick${k}check"; $$vn= ''; }
 382     foreach $k (qw(prefix subnet)) { $vn= "pickvar${k}"; $$vn= $in{$vn}; }
 383
 384     $_= $in{'specsize'};
 385     if (m/\d+/) {
 386         $pick_prefix= $&+0;
 387         $vn= "pick${pick_prefix}check"; $$vn= 'checked';
 388     } elsif (m/prefix|subnet/) {
 389         $which= $&;
 390         $vn= "pickvar${which}check"; $$vn= 'checked';
 391         $pick_prefix= $in{"pickvar${which}"};
 392         $pick_prefix =~ m/\d+/ or finish_error('badsize');
 393         $pick_prefix= $&+0;
 394         ($pick_prefix >= 0 && $pick_prefix <= 32) or finish_error('badsize');
 395         $pick_prefix= 32-$pick_prefix if $which eq 'subnet';
 396     } else {
 397         die "$_ ?";
 398     }
 399
 400     $network= $area_networks[$ai];
 401     $prefix= $area_prefixes[$ai];
 402     $net= display_net($network,$prefix);
 403     ($pick_prefix >= $prefix) or finish_error('wrongsize');
 404
 405     $fixmask= get_mask($prefix);
 406     $mask= get_mask($pick_prefix);
 407     $rnybs= randnybs(8);
 408     $rand= hex($rnybs);
 409     $value= hex($network) | ($rand & ($mask & ~$fixmask));
 410     $pick_network= sprintf '%08x',$value;
 411
 412     $net= display_net($pick_network,$pick_prefix);
 413     $displayemail= 1;
 414
 415 printf DEBUG "picking network=$network prefix=$prefix net=$net pick_prefix=$pick_prefix\n";
 416 printf DEBUG "picking rnybs=%s fixmask=%08x mask=%08x rand=%08x ".
 417     "value=%08x pick_network=%s net=%s\n",
 418     $rnybs,$fixmask,$mask,$rand,$value,$pick_network,$net;
 419
 420     $ent= { };
 421     $db{'picked'}= $ent;
 422     $ent->{'network'}= $pick_network;
 423     $ent->{'prefix'}= $pick_prefix;
 424     $list_areai= $ai;
 425     list_database('area');
 426 }
 427
 428 sub finish_error ($) {
 429     my ($type) = @_;
 430     my ($t, $esel, $f);
 431     foreach $t (qw(noemail nonet noname nocontact badsize wrongsize badnet wrongnet
 432                    nopassword badpassword notfound badchar)) {
 433         $esel= "error_$t";
 434         $$esel= 0;
 435         $f=1 if $type eq $t;
 436     }
 437     die $type unless $f;
 438     $esel= "error_$type";
 439     $$esel= 1;
 440     $error= 1;
 441     finish();
 442 }
 443
 444 sub finish () {
 445     process_file('template.html');
 446     print $out or die $!;
 447     close STDOUT or die $!;
 448     exit 0;
 449 }
 450
 451 sub foreach_start_area { $area_i=0; }
 452 sub foreach_cond_area { return $area_i < @area_networks; }
 453 sub foreach_incr_area { $area_i++; }
 454 sub foreach_setvars_area {
 455     $area_network= $area_networks[$area_i];
 456     $area= display_net($area_network,$area_prefixes[$area_i]);
 457     $area_recommended= $area_i==$rec_areai;
 458     $area_pickchecked= $area_i==$current_areai ? 'checked' : '';
 459     $area_listing= $area_i eq $list_areai;
 460 #    out("<!-- setvars_area @area_networks $area_i $area $list_areai -->");
 461 }