#!/usr/bin/perl
# Main G-RIN CGI script code.  Must be invoked with --cgi if
# as a CGI script - see the example file cam-grin.
#
# Copyright (C) 1999 Ian Jackson <ijackson@chiark.greenend.org.uk>
#
# This is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2,
# or (at your option) any later version.
#
# This is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with this file; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

use POSIX;

@org_argv= @ARGV;
$needrenew= 0;

if ($ARGV[0] eq '--cgi') {
    shift @ARGV;
    $invokestyle= 'cgi';
} elsif ($ARGV[0] eq '--expire-noconfirm') {
    shift @ARGV;
    $invokestyle= 'maintain';
} elsif ($ARGV[0] eq '--expire-norenew') {
    shift @ARGV;
    $invokestyle= 'maintain';
    $needrenew= 1;
} elsif ($ARGV[0] =~ m/^--/) {
    die "$ARGV[0] ?";
} elsif ($ENV{'SERVER_SOFTWARE'} =~ m/^Lynx/) {
    $invokestyle= 'lynxcgi';
} else {
    $invokestyle= 'manual';
}

if ($invokestyle eq 'manual') {
    open DEBUG,">&STDERR" or die $!;
} elsif ($invokestyle eq 'lynxcgi') {
    open DEBUG,">>debug.txt" or die $!;
} elsif ($invokestyle eq 'cgi' || $invokestyle eq 'maintain') {
    open DEBUG,">/dev/null" or die $!;
}

if ($invokestyle eq 'cgi' || $invokestyle eq 'maintain') {
    $scriptdir= shift @ARGV;
    $datadir= shift @ARGV;
} else {
    $scriptdir= '.';
    $datadir= '.';
}

if (!($invokestyle eq 'manual' || $invokestyle eq 'maintain')) {
    $ct= 'BCP5REGISTRY_CONTENTTYPEDONE';
    if (!$ENV{$ct}) {
	$|=1;
	print "Content-Type: text/html\n\n" or die $!;
	$|=0;
	$ENV{$ct}= 1;
    }
}

push @INC,$scriptdir;
chdir($datadir) or die $!;

require 'config.pl';
require 'database.pl';
require 'utils.pl';
require 'networks.pl';
require 'listdb.pl';
require 'passwords.pl';

if (!($invokestyle eq 'manual' || $invokestyle eq 'maintain')) {
    lock_database();
    require 'cgi-lib.pl';
    &ReadParse;
    foreach $k (keys %in) { print DEBUG "$k -> \"$in{$k}\"\n"; }
} else {
    foreach $x (@ARGV) {
	$x =~ m/^(\w+)\=/ or die "$x ?";
	$in{$1}= $';
	print DEBUG "$1 -> \"$'\"\n";
    }
}

if ($invokestyle eq 'lynxcgi') {
    defined($pwd= getcwd) or die $!;
    $_= $0; s,^.*/,,;
    $cgi= "lynxcgi:$pwd/$_";
}

@area_networks= qw(0a000000 ac100000 c0a80000);
@area_prefixes= qw(8 12 16);
$rec_areai= 1;

$current_areai= $rec_areai;
$list_areai= '';
$listoverlap= '';

$listing= '';
$intro= 0;
$error= 0;
$registernew= 0;
$pick= 0;
$deleted= 0;
$pickvarsubnet= 8;
$pickvarprefix= 24;
$pick28check= '';
$pick24check= 'checked';
$pickvarsubnetcheck= '';
$pickvarprefixcheck= '';
$details= 0;
$fulldetails= 0;
$justcreated= 0;
$justupdated= 0;
$picked= 0;
$listingall= 0;
$passwordsent= 0;
$list= 0;
$notfound= 0;
$id= '';
$name= '';
$contact= '';
$email= '';
$net= '';
$emailhidechecked= '';
$hiddenemail= 0;

$listingarea= length $list_areai;
$listingoverlap= length $listoverlap;

defined($now= time) or die $!;

if ($invokestyle eq 'maintain') {

    lock_database();
    read_database();

    if ($needrenew) {
	$threshold_recent= $now - $renew_interval;
	$threshold_old= $threshold_recent - $expire_norenew;
    } else {
	$threshold= $now - $expire_noconfirm;
    }

    $changed= 0;

    foreach $id (keys %db) {
	$ent= $db{$id};
	if ($needrenew) {
	    next unless $ent->{'changed'};
	    next if $ent->{'changed'} >= $threshold_recent;
	    if ($ent->{'changed'} > $threshold_old) {
		show_entry();
		send_password();
		print "sent renewal for $id ($net)\n" or die $!;
		next;
	    }
	    show_entry();
	    printf("deleted stale %s (%s, %x %x %x)\n",
		   $id, $net, $threshold_recent, $threshold_old,
		   $ent->{'changed'}) or die $!;
	} else {
	    next if $ent->{'changed'};
	    next if $ent->{'created'} >= $threshold;
	    show_entry();
	    printf("deleted new %s (%s, %x %x)\n",
		   $id, $net, $threshold, $ent->{'created'}) or die $!;
	}
	delete $db{$id};
	$changed= 1;
    }

    if ($changed) {
	write_database();
    }
    close STDOUT or die $!;
    exit 0;

} elsif (length $in{'register'}) {
    
    lock_database();
    read_database();
    
    $id= randnybs(16);
    $db{$id}= $ent= { };
    $ent->{'created'}= $now;
    $ent->{'changed'}= 0;
    $alwaysemail= $email= $in{'email'};
    set_entry();

    $justcreated= 1;
    send_password();

    show_entry();
    finish();
    
} elsif (length $in{'mailpasswd'}) {

    read_database();
    get_entry();
    show_entry();

    $passwordsent= 1;
    send_password();

    finish();
    
} elsif (length $in{'view'}) {

    read_database();
    get_entry();
    check_password();

    $fulldetails= 1;
    show_entry();
    finish();
    
} elsif (length $in{'update'}) {
    
    lock_database();
    read_database();
    get_entry();
    check_password();

    $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();
    read_database();
    get_entry();
    check_password();

    $deleted= 1;
    show_entry();

    delete $db{$id};
    write_database();

    finish();

} elsif (length $in{'pick'}) {

    read_database();
    pick_net();
    $picked= 1;
    $pick= 1;
    $list= 1;
    $listoverlap= $net;
    finish();

} elsif (length $in{'list'}) {

    read_database();
    $list_areai= $in{'listareai'};
    list_database($in{'list'});
    finish();

} elsif (length $in{'id'}) {

    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 {

    $intro= 1;
    $list= 1;
    $pick= 1;
    $displayemail= 1;
    $registernew= 1;
    finish();

}

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;
}

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";
    }
    $alwaysemail= $email;
    if ($ent->{'hiddenemail'} && !$justcreated && \
	       !$fulldetails && !$justupdated && !$deleted) {
	$displayemail= 0;
	$email= '';
    } else {
	$displayemail= 1;
    }
    $net= display_net($network,$prefix);
    $emailhidechecked= $ent->{'hiddenemail'} ? 'checked' : '';
    $listoverlap= $net;
}

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(network prefix name contact email hiddenemail)) {
	$ent->{$k}= $$k;
    }

    write_database();
}

sub pick_net () {
    my ($ai, $k, $vn, $rand, $mask, $fixmask, $value);
    
    $ai= $in{'from'}; $ai =~ m/\d+/ or die "$ai ?"; $ai= $&;
    ($ai>=0 && $ai<@area_networks) or die "$ai ?";
    $current_areai= $ai;

    foreach $k (qw(24 28 prefix subnet)) { $vn= "pick${k}check"; $$vn= ''; }
    foreach $k (qw(prefix subnet)) { $vn= "pickvar${k}"; $$vn= $in{$vn}; }

    $_= $in{'specsize'};
    if (m/\d+/) {
	$specsize= $&+0;
	$vn= "pick${specsize}check"; $$vn= 'checked';
    } elsif (m/prefix|subnet/) {
	$which= $&;
	$vn= "pickvar${which}check"; $$vn= 'checked';
	$specsize= $in{"pickvar${which}"};
	$specsize =~ m/\d+/ or finish_error('badsize');
	$specsize= $&+0;
	($specsize >= 0 && $specsize <= 32) or finish_error('badsize');
	$specsize= 32-$specsize if $which eq 'subnet';
    } else {
	die "$_ ?";
    }

    $network= $area_networks[$ai];
    $prefix= $area_prefixes[$ai];
    $net= display_net($network,$prefix);
    ($specsize >= $prefix) or finish_error('wrongsize');

    $fixmask= get_mask($prefix);
    $mask= get_mask($specsize);
    $rnybs= randnybs(8);
    $rand= hex($rnybs);
    $value= hex($network) | ($rand & ($mask & ~$fixmask));
    $vhex= sprintf '%08x',$value;

    $net= display_net($vhex,$specsize);
    $displayemail= 1;

printf DEBUG "picking network=$network prefix=$prefix net=$net specsize=$specsize\n";
printf DEBUG "picking rnybs=%s fixmask=%08x mask=%08x rand=%08x ".
    "value=%08x vhex=%s net=%s\n",
    $rnybs,$fixmask,$mask,$rand,$value,$vhex,$net;

    $ent= { };
    $db{'picked'}= $ent;
    $ent->{'network'}= $vhex;
    $ent->{'prefix'}= $specsize;
    $list_areai= $ai;
    list_database('area');
}

sub finish_error ($) {
    my ($type) = @_;
    my ($t, $esel, $f);
    foreach $t (qw(noemail nonet noname nocontact badsize wrongsize badnet wrongnet
		   nopassword badpassword notfound badchar)) {
	$esel= "error_$t";
	$$esel= 0;
	$f=1 if $type eq $t;
    }
    die $type unless $f;
    $esel= "error_$type";
    $$esel= 1;
    $error= 1;
    finish();
}

sub finish () {
    process_file('template.html');
    print $out or die $!;
    close STDOUT or die $!;
    exit 0;
}

sub foreach_start_area { $area_i=0; }
sub foreach_cond_area { return $area_i < @area_networks; }
sub foreach_incr_area { $area_i++; }
sub foreach_setvars_area {
    $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 eq $list_areai;
#    out("<!-- setvars_area @area_networks $area_i $area $list_areai -->");
}
