#!/opt/local/bin/perl -wT

###############################################################################
#
# generate new document ID number and send info to archive librarian
#
# Greg Fruth, Flight Mechanics Department
#
# v0.5, 22 May 1995
# v0.6, 30 Jan 1996 : rewritten
# v0.7,  2 Mar 2000 : use flock for file locking, Y2K fixes
# v1.1,  5 Apr 2001 : rewrite; "use CGI", new look and feel,
#                     keyword field added, filter "^" in output
# v1.2, 22 Jun 2001 : support multiple orgs; CCC field added; "use strict";
#                     UseSection field added
# v1.3, 31 Aug 2001 : taint mode, adapt for web.aero.org
# v1.4,  5 Apr 2002 : re-adapt for web.aero.org
#
###############################################################################

# fixme: trap signals to ensure sequence file integrity

use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Time::Local;
use Fcntl ':flock';
use strict;

# global variables
use vars qw($Query $Debug $Now $MyCCC %UserDir);
use vars qw($ConfFile $Style $LibrarianDesc $LibrarianAddr $UseSection);

use vars qw($SeqDir);
use vars qw($Sendmail $CountMax $SleepTime);
use vars qw(@Errors);
use vars qw($Day $Mon $Year $Sect $Subj $Auth $Dist $Clas $Keyw $Url);
use vars qw($Host $DocId);
use vars qw(%Label);

require('./doc_util.pl');

$Query         = new CGI;
$Debug         = 0;
$Now           = 0;
$MyCCC         = '????';
$ConfFile      = 'config.txt';
$Style         = '';
$LibrarianDesc = 'the Archive Librarian';
$LibrarianAddr = 'root';
$UseSection    = 0;

$SeqDir        = 'sequence';
$Sendmail      = '/usr/lib/sendmail';
$CountMax      = 5;
$SleepTime     = 1;
@Errors        = ();
$Day           = '';
$Mon           = '';
$Year          = '';
$Sect          = '';
$Subj          = '';
$Auth          = '';
$Dist          = '';
$Clas          = '';
$Keyw          = '';
$Url           = '';
$Host          = '';
$DocId         = '';

%Label = (
	  'DocId'  => 'Document ID',
	  'Date'   => 'Publication date',
	  'Sect'   => 'Section',
	  'Subj'   => 'Subject',
	  'Auth'   => 'Author',
	  'Dist'   => 'Distribution',
	  'Clas'   => 'Classification',
	  'Keyw'   => 'Keywords',
	  'Url'    => 'URL',
	  );

###############################################################################
# main body
###############################################################################
main();
exit(0);

###############################################################################
# main body
###############################################################################
sub main {
    my ($key, $value);
    my ($Errors, $error);

    $Errors = '';
    $error  = '';

    # get inputs
    foreach $key ($Query->param) {
	$value = $Query->param($key);
	next unless (defined($value) && $value); # skip empty params
	
	$Day   = $value, next if ($key eq 'Day');
	$Mon   = $value, next if ($key eq 'Mon');
	$Year  = $value, next if ($key eq 'Year');
	$Sect  = $value, next if ($key eq 'Sect');
	$Subj  = $value, next if ($key eq 'Subj');
	$Auth  = $value, next if ($key eq 'Auth');
	$Dist  = $value, next if ($key eq 'Dist');
	$Clas  = $value, next if ($key eq 'Clas');
	$Keyw  = $value, next if ($key eq 'Keyw');
	$Url   = $value, next if ($key eq 'Url');
	$MyCCC = $value, next if ($key eq 'MyCCC');
	$Debug = $value, next if ($key eq 'Debug');
    }
    $Host = $Query->remote_host();

    # untaint
    if ($MyCCC =~ /^(\d+)$/)    {$MyCCC = $1}
    else                        {$MyCCC = ''}
    if ($Year =~ /^(\d+)$/)     {$Year = $1}
    else                        {$Year = ''}
    if ($Sect =~ /^([\-\w]+)$/) {$Sect = $1}
    else                        {$Sect = ''}
    $ENV{PATH} = '/bin:/usr/bin';
    delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

    # make sure we deny write permission to group, other
    umask(022);
    
    $Errors = ReadConf($ConfFile);

    Header('Register New Document', $Style);

    if ($Errors) {
	htmlError('cannot read config file', $Errors);
    }
    else {
	if (InputsAreValid()) {
	    $DocId = GetDocId();
	    SendMail() if ($DocId);
	}
	else {
	    $Errors = '<ul>';
	    foreach $error (@Errors) {
		$Errors .= "<li><em>invalid field:</em> $error";
	    }
	    $Errors .= '</ul>';
	    htmlWarning('invalid inputs',
			"Some of the inputs were invalid or incomplete. " .
			"Use your browser's \"Back\" button to return to " .
			"the form and resubmit your request.<br>$Errors");
	}
    }
    Tailer();
}

###############################################################################
# validate form inputs
# return 1 if they're OK, otherwise print an error message and return 0
###############################################################################
sub InputsAreValid {
    my $retval = 1;

    @Errors = ();

    if (! isValidDate(\$Year, \$Mon, \$Day)) {
	push(@Errors, "$Label{Date} (invalid date)");
	$retval = 0;
    }
    if ($UseSection) {
	if ($Sect !~ /\w/) {
	    push(@Errors, "$Label{Sect} (must not be empty)");
	    $retval = 0;
	}
	elsif ($Sect !~ /^[\-\w]+$/) {
	    push(@Errors, "$Label{Sect} (valid characters: " .
		 "0-9, a-z, A-Z, underscore (\"_\"), minus (\"-\"))");
	    $retval = 0;
	}
    }
    if ($Subj !~ /\w/) {
	push(@Errors, "$Label{Subj} (must not be empty)");
	$retval = 0;
    }
    if ($Auth !~ /\w/) {
	push(@Errors, "$Label{Auth} (must not be empty)");
	$retval = 0;
    }
    if ($Dist !~ /\w/) {
	push(@Errors, "$Label{Dist} (must not be empty)");
	$retval = 0;
    }
    if ($Clas !~ /\w/) {
	push(@Errors, "$Label{Clas} (must not be empty)");
	$retval = 0;
    }
    if ($Keyw !~ /\w/) {
	push(@Errors, "$Label{Keyw} (must not be empty)");
	$retval = 0;
    }
    $Url = '(TBD)' unless ($Url =~ /\w/);
    if ($MyCCC !~ /\w/) {
	push(@Errors, "MyCCC (must not be empty)");
	$retval = 0;
    }
    elsif ($MyCCC !~ /^\d+$/) {
	push(@Errors, "MyCCC (valid characters: 0-9)");
	$retval = 0;
    }
    if (!$Host) {
	htmlError('Unknown host name!',
		  'Your host name could not be determined');
	$retval = 0;
    }

    return($retval);
}

###############################################################################
# construct new document ID
# if successful, return the ID, else print an error message and return
# the null string
###############################################################################
sub GetDocId {
    my ($seqFile, $seqNo, $count);
    my $retval = '';

    if (!defined($UserDir{$MyCCC})) {
	htmlError("No UserDir defined for CCC $MyCCC");
	return($retval);
    }

    if ($UseSection) {
	$seqFile = "$UserDir{$MyCCC}/$SeqDir/$Year" . "_" . "$Sect";
    }
    else {
	$seqFile = "$UserDir{$MyCCC}/$SeqDir/$Year";
    }

    # open appropriate sequence file, or create one if it doesn't exist
    if (!open(SEQFILE, '+>>' . $seqFile)) {
	htmlError("Cannot open file \"$seqFile\"!", "open() failed: $!");
	return($retval);
    }
    
    # if file is locked by someone else, wait until it is unlocked
    $count = 0;
    while (! flock(SEQFILE, LOCK_EX | LOCK_NB)) {
	$count++;
	if ($count > $CountMax) {
	    htmlError("Cannot lock file \"$seqFile\"!",
		      "flock() failed: too many lock attempts");
	    return($retval);
	}
	# file is locked, sleep a while then try again
	sleep($SleepTime);
    }

    # get sequence number
    $seqNo = 1;
    while(<SEQFILE>) { # if the file is empty, this leaves seqNo = 1
	chomp;
	$seqNo = $_;
    }

    # detect corrupted sequence data
    if ($seqNo !~ /\d+/) {
	htmlError('Sequence file corrupted!' ,
		  "Sequence file \"$seqFile\" corrupted at line $.: " .
		  "\"$seqNo\"!");
	return($retval);
    }

    # construct document ID
    if ($UseSection) {
	$retval = sprintf("A%04d-%4d.%s-%03d", $Year, $MyCCC, $Sect, $seqNo);
    }
    else {
	$retval = sprintf("A%04d-%4d-%03d", $Year, $MyCCC, $seqNo);
    }

    # update sequence
    $seqNo++;
    truncate(SEQFILE, 0);
    print(SEQFILE "$seqNo\n");
    close(SEQFILE);

    return($retval);
}

###############################################################################
# send E-mail to log librarian
###############################################################################
sub SendMail {
    my $date = $Year . '/' . $Mon . '/' . $Day;
    my $value;

    if (open(MAIL, "| $Sendmail $LibrarianAddr")) {
	select(MAIL);
	
	# filter out carets (replace with the HTML escape sequence)
	foreach $value ($DocId, $Url, $date, $Auth, $Clas, $Dist, $Subj,
			$Keyw) {
	    $value =~ s/\^/\&\#710;/g;
	}

	print <<EOF;
Subject: New Document ($DocId)

###############################################################################
Please enter the following information into the document log:
###############################################################################
$Label{'DocId'} = $DocId
$Label{'Url'} = $Url
$Label{'Date'} = $date
$Label{'Auth'} = $Auth
$Label{'Clas'} = $Clas
$Label{'Dist'} = $Dist
$Label{'Subj'} = $Subj
$Label{'Keyw'} = $Keyw

###############################################################################
For pasting into Excel, here is the information caret-delimited:
###############################################################################
$DocId^$Url^$date^$Auth^$Clas^$Dist^$Subj^$Keyw

###############################################################################
Request sent from "$Host"
EOF
	close(MAIL);
	select(STDOUT);

	# parrot back the info

	print("<h1>The document identification number is " .
	      "<em class=\"highlight\">$DocId</em></h1>");

	beginPanel('header');
	print('Note');
	midPanel('data');
	print("The document will be added to the log by $LibrarianDesc " .
	      "after it has been verified.  Remember to give an electronic " .
	      "copy of your document to " .
	      "<a href=\"mailto:$LibrarianAddr\">$LibrarianDesc</a> " .
	      "so it can be placed on line.");
        endPanel();
	print('<br>');

	beginPanel('header');
	print('Document Information');
	midPanel('data');
	print <<EOF;
<table border=0>
<tr><td class="label" align="right">$Label{'Date'}:</td>
<td class="data">$date</td></tr>
<tr><td class="label" align="right">$Label{'Subj'}:</td>
<td class="data">$Subj</td></tr>
<tr><td class="label" align="right">$Label{'Auth'}:</td>
<td class="data">$Auth</td></tr>
<tr><td class="label" align="right">$Label{'Dist'}:</td>
<td class="data">$Dist</td></tr>
<tr><td class="label" align="right">$Label{'Clas'}:</td>
<td class="data">$Clas</td></tr>
<tr><td class="label" align="right">$Label{'Keyw'}:</td>
<td class="data">$Keyw</td></tr>
<tr><td class="label" align="right">$Label{'Url'}:</td>
<td class="data">$Url</td></tr>
</table>
EOF
        endPanel();
    }
    else {
	htmlError("E-mail message could not be sent to $LibrarianAddr!",
		  "sendmail failed: $!");
    }
}