#!/usr/local/bin/perl # @(#)csa.cgi 00/08/16 copyright 2000 Karl L. Dunn # Print MIME header print "Content-type: text/html\n\n"; # The address the notification mail will go to. # The backslash before the at-sign is NECESSARY. $scriptmonitor = "kdunn\@localhost"; # The "from" address for the mailer $scriptmailer = "kdunn\@localhost"; # Determine our home directory $home_dir = "/home/kdunn"; # Default # Where the files are $word_list = "$home_dir/public_html/cgi-bin/nlist"; $CSAeng = "$home_dir/public_html/cgi-bin/spook"; $SENDMAIL = "/usr/lib/sendmail"; # Check that the POST method was used if ($ENV{'REQUEST_METHOD'} eq 'POST') { # Check for too much data. $Input_Size = $ENV{'CONTENT_LENGTH'}; if ($Input_Size =~ /^[0-9]+$/ && $Input_Size < 2048) { # Can handle length. Read in variables from form. read (STDIN, $inbuf, $Input_Size); if ($inbuf =~ /^ciphergram=[0-9a-zA-Z_\-\*\+\@\.\&\=\%]*&attribution=[0-9a-zA-Z_\-\*\+\@\.\&\=\%]*&startkey=[a-zA-Z\+]*&SelfOK=[A-Z]+$/) { # Looks as if input is formatted OK. Break it up into pairs. @pairs = split(/&/, $inbuf); # Convert the pairs into an associative array foreach $pair (@pairs) { ($key, $value) = split(/=/, $pair); $input{$key} = $value; } # Print HTML
and print &HtmlBegin ("Ciphergram Solution Assistant Results"); # Determine whether to relax the nonidentity rule $selfok = $input{'SelfOK'}; if ($selfok eq 'NOTOK') { $nslfok = 0; } elsif ($selfok eq 'OK') { $nslfok = 1; } else { # SelfOK neither NOTOK nor OK print &HtmlBegin ("Ciphergram Solution Assistant Access Error"); print "\n"; print "Error 1: Improper data input to form!\n"; print "
\n"; print "Input has improper entry or is badly formatted.\n"; print "You may need to use a different browser.\n"; print "
\n"; print "If you did not access the CSA directly, you might want to try this: "; print "Ciphergram Solution Assistant\n
\n"; print "\n\n"; &MailErr ("Bad POST input (NOTOK/OK):\n[$inbuf]\n"); } # Determine whether to solve the puzzle or mail it # Solve it here # Convert the start key pairs into a 26-letter key $key_OK = "1"; @keypairs = split(/\+/, $input{'startkey'}); $skey = " "; foreach $keypair (@keypairs) { $keypair =~ tr/a-z/A-Z/; if (length($keypair) == 2) { $plainlet = substr($keypair, 1, 1); $ciphlet = substr($keypair, 0, 1); if ($plainlet ne $ciphlet) { $indexkeystr = ord($ciphlet) - ord("A"); $headkeystr = substr($skey, 0, $indexkeystr); $tailkeystr = substr($skey, $indexkeystr + 1, 25 - $indexkeystr); $skey = $headkeystr.$plainlet.$tailkeystr; } else { $key_OK = 0; last; } } else { $key_OK = 0; last; } } if ($key_OK == 0) { print "
The Starting Key is not a set of letter pairs, or\n"; print "
you have tried to make a cipher letter the same as\n"; print "
a plaintext letter.\n"; print "
Please go back to the form, fix it, and try again.\n\n"; $results = "Bad starting key"; } else { # Use CSAeng to get results # Check for busy if ( glob "$home_dir/public_html/cgi-bin/x/????????.x" ) { $results = "The CSA is busy. Please try again shortly\n"; } else { # Create a name for the process ($ip1,$ip2,$ip3,$ip4) = split(/\./, $ENV{"REMOTE_ADDR"}); $procname ="$home_dir/public_html/cgi-bin/x/" . sprintf("%02x%02x%02x%02x", $ip1,$ip2,$ip3,$ip4) . ".x"; link($CSAeng, $procname); $results = `nice $procname $nslfok $word_list "$skey" "$input{'ciphergram'}" "$input{'attribution'} "`; unlink($procname); } # Present the results if ($results =~ "Error:") { print "\n
\nClick \n"; print "here\n"; print " for more information.\n
Either you forgot to fill in both the Ciphergram\n"; print " and the Attribution, or one or both is far too long.\n"; print "
Please go back to the form, fix it, and try again.\n\n"; } else { print "\n$results\n"; } } # Finish up print "