home *** CD-ROM | disk | FTP | other *** search
/ bombers.k12.ar.us / bombers.k12.ar.us.tar / bombers.k12.ar.us / cgi-bin / utils1.pl < prev   
Text File  |  2003-10-07  |  16KB  |  525 lines
  1. $eventlist =$datapath.'events.dat';
  2. $registry =    $datapath.'registry.dat';
  3. $registrar =$CGI_URL.'registrar.pl';
  4. $admin = $CGI_URL.'secure/admin.pl';
  5. $adminURL =    $URL.'/admin';
  6. $eventURL=$CGI_URL.'registrar.pl';
  7.  
  8.  
  9.  
  10. ###############################################################################
  11. sub main {
  12.     if ($bgcolor){$bgcolor=" BGCOLOR=\"$bgcolor\" ";}
  13.     if ($background){$background=" BACKGROUND=\"$background\" ";}
  14.     if ($adminbuttons){$adminbuttons=" ADMINBUTTONS=\"$adminbuttons\" ";}
  15.  
  16.  
  17.     if ($::debug) {
  18.         print "Content-type: text/html\n\n
  19.             <HTML><HEAD><TITLE>DEBUG</TITLE></HEAD>
  20.             <BODY $bgcolor $background><H2>DEBUG MODE</H2>\n";
  21.         }
  22.  
  23.  
  24.     # PARSE THE FORM INPUT
  25.  
  26.     &form_parse;
  27.  
  28.  
  29.     # BEGIN THE HTML PAGE
  30.  
  31.     &header2;
  32.  
  33.  
  34.     # DECIDE WHERE TO GO NEXT
  35.  
  36.     if($E{'regform'})    {®form;}
  37.     if($E{'register'})    {®ister;}
  38.     ®istrar;
  39.     if ($::debug) {print "</BODY></HTML>\n";}
  40.     }
  41. ###############################################################################
  42. # form_parse: Reads in the form information from a POST and
  43. # parses it out into $E{'variable_name'}
  44. sub form_parse {
  45.  
  46.  
  47.     # GET THE INPUT
  48.  
  49.     read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  50.  
  51.  
  52.     # SPLIT THE NAME-VALUE PAIRS
  53.  
  54.     @pairs = split(/&/, $buffer);
  55.  
  56.     foreach $pair (@pairs) {
  57.         ($name, $value) = split(/=/, $pair);
  58.  
  59.  
  60.          # UN-WEBIFY PLUS SIGNS AND %-ENCODING
  61.  
  62.         $value =~ tr/+/ /;
  63.         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  64.         $name =~ tr/+/ /;
  65.         $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  66.  
  67.         # Stop people from using subshells to execute commands
  68.         # Not a big deal when using sendmail, but very important
  69.         # when using UCB mail (aka mailx).
  70.  
  71.         # $value =~ s/~!/ ~!/g;
  72.         $value =~ s/<!--(.|\n)*-->//g;
  73.         $value =~ s/"/'/g;                # neutralize quotes
  74.         $value =~ s/^\s*//;                # remove leading whitespace
  75.         $value =~ s/\s*$//;                # remove trailing whitespace
  76.         $value =~ s/\r\n/\n/g;                #NEW: make windows files look Unix
  77.         $value =~ s/\n/<BR>/g;                #NEW: kill the carriage returns
  78.         $value =~ s/&/and/g;                #NEW: kill the ampersands
  79.  
  80.         &db("FORM_PARSE: Setting $name to $value");
  81.  
  82.         $E{$name} = $value;
  83.         }
  84.     } # end sub
  85. ##############################################################################
  86. # OUTPUT A DEBUG LINE
  87. sub db {
  88.     $line = shift;
  89.     if(!$::debug) {return 0;}
  90.     print "\n<!-- $line -->\n";
  91.     return 1;
  92.     } # END SUB
  93. ##############################################################################
  94. sub UnTaint{
  95.         $var = shift;
  96.         if ($var =~ m#^([-+><@\w./\\:]+)$#){
  97.             $var = $1;
  98.             }
  99.         else{
  100.             die "ERROR: File name can not be untainted: [$var]\n";
  101.             }
  102.         return($var);
  103.     } # END SUB UnTaint
  104. #######################################################################
  105. #    month2number - given month, return # for that month
  106. sub month2number {
  107.     if ($month =~ /jan/i) {$month=1;}
  108.     elsif ($month =~ /feb/i) {$month=2;}
  109.     elsif ($month =~ /mar/i) {$month=3;}
  110.     elsif ($month =~ /apr/i) {$month=4;}
  111.     elsif ($month =~ /may/i) {$month=5;}
  112.     elsif ($month =~ /jun/i) {$month=6;}
  113.     elsif ($month =~ /jul/i) {$month=7;}
  114.     elsif ($month =~ /aug/i) {$month=8;}
  115.     elsif ($month =~ /sep/i) {$month=9;}
  116.     elsif ($month =~ /oct/i) {$month=10;}
  117.     elsif ($month =~ /nov/i) {$month=11;}
  118.     elsif ($month =~ /dec/i) {$month=12;}
  119.     } # end sub
  120. #######################################################################
  121. #    todayjulean - returns today's julean date.  Calls julean.
  122. sub todayjulean    {
  123.      $date=localtime(time);
  124.      @date=split (/\s+/, $date);
  125.      $month=$date[1];
  126.      &month2number;
  127.      &julean ($month, $date[2], $date[4]);
  128.      $today = $jule;
  129.     } # end sub
  130. #######################################################################
  131. #    julean - returns julean date with jan 1, 1992 as day 1
  132. # Takes date in Month, day, and year order and finds julean date.
  133. # Outputs julean number for inputted date.
  134. #    This sub by David Moose Pitts, mod. by Rich Bowen and Chuck Lund
  135. #    Usage:   &julean(6, 16, 2003);
  136. sub julean {
  137.     $thisdayjulean=0;
  138.     #@months=(0,31,28,31,30,31,30,31,31,30,31,30,31);
  139.     my @months=(0,31,28,31,30,31,30,31,31,30,31,30,31);    # 9/24/03
  140.     $local_month=$_[0];
  141.     $tday=$_[1];
  142.     $tyear=$_[2];
  143.     $leapdays=( ($tyear-1992)/4 ) + 1;     #must be a leap year, so I chose 1992
  144.  
  145.  
  146.     # THIS SECTION DROPS THE REMAINDER OF THE LEAP DAY FOR THE YEAR.
  147.  
  148.     $leapdays2=(($tyear-1992)%4);
  149.     $leapdays-=($leapdays2*0.25);
  150.     if ($tyear % 100==0 ) {if ($tyear % 400 == 0) {$leapdays -= 1;}}
  151.                                            # even 100 year years do not have
  152.                                            # leap days in them except those
  153.                                            # divisible by 400
  154.     $local_thisyear=$tyear-1992;
  155.     for ($local_i=1;$local_i<=$local_thisyear;$local_i++) {$thisdayjulean+=365;}
  156.     for ($local_i=1;$local_i<$local_month;$local_i++) {$thisdayjulean+=$months[$local_i];}
  157.             #minus 1 because current month not complete
  158.  
  159.     if ($local_month<3 && $leapdays2==0) {$leapdays--;}
  160.     $thisdayjulean+=$leapdays+$tday;
  161.     $jule=$thisdayjulean;
  162.     } # end sub
  163. #######################################################################
  164. #    redirect - redirect to another URL
  165. #     usage: &redirect('http://www.acme.com');
  166. sub redirect {
  167.     if($::debug) {
  168.         print "\nRedirect to: <A HREF=\"$_[0]\">$_[0]</A>\n";
  169.         }
  170.     else {
  171.         print"Location: $_[0] \n\n";
  172.         }
  173.     } # end sub
  174. ###############################################################################
  175. #    get_date - get the date from the system, version 2
  176. sub get_date {
  177.     @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
  178.     #@months = ('January','February','March','April','May','June','July',
  179.     my @months = ('January','February','March','April','May','June','July',    # 9/24/03
  180.         'August','September','October','November','December');
  181.     ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  182.     if ($hour < 10) { $hour = "0$hour"; }
  183.     if ($min < 10) { $min = "0$min"; }
  184.     if ($sec < 10) { $sec = "0$sec"; }
  185.     $time = "$hour\:$min\:$sec";
  186.     $year += 1900;
  187.     $date = "$days[$wday], $months[$mon] $mday, $year at $time";
  188.     } # end sub
  189. #######################################################################
  190. #    conf_number - generate a 5-digit random confirmation number
  191. sub conf_number {
  192.       srand;
  193.       $conf=int(rand(100000));
  194.     } # end sub
  195. ###############################################################
  196. sub footer2 {
  197.  
  198. print <<"eopage";
  199. <HR><font class="footertext">$footer</font></TD>
  200. </TR></TABLE>
  201. </CENTER>
  202. </BODY></HTML>
  203. eopage
  204.  
  205.     } # end sub
  206. ###############################################################
  207. sub header2 {
  208.     print "Content-type: text/html\n\n";
  209.  
  210. print <<"eopage";
  211. <HTML><HEAD>
  212. <TITLE>$pagetitle</TITLE>
  213. $pagecss
  214. </HEAD>
  215. <BODY $bgcolor $background>
  216. <CENTER>
  217. <TABLE class="tableborder">
  218. <TR><TD class="pagetitlespecs">
  219. $pagetitle</TD>
  220. </TR>
  221. <TR><TD class="tablecolor">
  222. eopage
  223.  
  224.     } # end sub
  225. ###############################################################
  226. #    month_txt - given #, return month
  227. sub month_txt {
  228.     ($_)=@_;
  229.     if    ($_==1)  {$month_txt = 'January';}
  230.     elsif ($_==2)  {$month_txt='February';}
  231.     elsif ($_==3)  {$month_txt='March';}
  232.     elsif ($_==4)  {$month_txt='April';}
  233.     elsif ($_==5)  {$month_txt='May';}
  234.     elsif ($_==6)  {$month_txt='June';}
  235.     elsif ($_==7)  {$month_txt='July';}
  236.     elsif ($_==8)  {$month_txt='August';}
  237.     elsif ($_==9)  {$month_txt='September';}
  238.     elsif ($_==10) {$month_txt='October';}
  239.     elsif ($_==11) {$month_txt='November';}
  240.     elsif ($_==12) {$month_txt='December';}
  241.     else {$month_txt='ERROR in Month';}
  242.     } # end sub
  243. ###############################################################################
  244. sub open2 {
  245.     $iz=0;
  246.     while(-f $lockfile) {
  247.         sleep 2;            # wait from 1 to 2 seconds to check again
  248.         $iz++;
  249.         if($iz > 5) {unlink($lockfile);} # delete, if file was not released within 5-10 seconds
  250.         }
  251.     open(LOCKFILE,">$lockfile") || die "Can't create lock file";    # create a lockfile
  252.     open($_[0], $_[1]) || return 0;        # open the database, return failed if unavailable
  253.     return 1;                # return passed
  254.     } # end sub
  255. ###########################################################
  256. sub close2 {
  257.     close($_[0]);
  258.     close(LOCKFILE);
  259.     unlink($lockfile) || die "Can't delete lock file";
  260.     } # end sub
  261. ###########################################################
  262. # Print html page when form data is missing
  263. sub nox {
  264.  
  265. print <<"eopage";
  266. <CENTER>
  267. <H1><FONT COLOR="#FF0000">ERROR</FONT></H1></CENTER></TD>
  268. </TR>
  269. <TR>
  270. <TD BGCOLOR="#FFFFFF">
  271. <H3>"$missing" was not entered.</H3
  272. This information is needed to process your registration.<BR>
  273. Please use your browser's "back" button to return to the form and 
  274. enter "$missing."
  275. eopage
  276.  
  277.     &footer2;
  278.     exit;
  279.     } # end sub
  280. #######################################################################
  281. # Warn when file cannot be opened
  282. # Uses string "$missing" which identifies the file being opened
  283. sub punt {
  284.     $missing="ERROR: Could not open $missing<BR>Please notify system administrator.";
  285.     &header2;
  286.  
  287. print <<"eopage";
  288. <CENTER>
  289. <H2>$missing</H2>
  290. </CENTER><BR>
  291. eopage
  292.  
  293.     &footer2;
  294.     exit;
  295.     } # end sub
  296. #######################################################################
  297. # print html for nav button(s)
  298. sub nav {
  299.     print "<CENTER><A HREF=\"$adminURL\">
  300.         <IMG SRC=\"$adminbuttons/admin.gif\" BORDER=0 HEIGHT=36 WIDTH=238
  301.          ALT=\"Administrator's Console\"></A><BR>
  302.         <A HREF=\"$CGI_URL/registrar.pl\"><IMG SRC=\"$adminbuttons/registrar.gif\" 
  303.          BORDER=0 HEIGHT=43 WIDTH=195 ALT=\"Registration Form\"></A><BR>
  304.         <A HREF=\"../../../help/Troubleshooting.html\">
  305.         <IMG SRC=\"$adminbuttons/help.gif\" BORDER=0 HEIGHT=36 WIDTH=238
  306.          ALT=\"Help & Troubleshooting\"></A><BR></CENTER>\n
  307.         ";
  308.     }
  309. ########################################################################
  310. # Remove registrants from the registry when marked as deleted or
  311. # when the class no longer exists.
  312. sub purge {
  313.  
  314.  
  315.     # READ IN ALL THE REGISTRY DATA
  316.  
  317.     &getregistry;
  318.  
  319.  
  320.     # WRITE OUT THE VALID LINES
  321.  
  322.     $paren='';
  323.     if($::debug) {$paren = " ($registry)";}
  324.     $missing = "Registry for$paren writing.";
  325.     
  326.     if(!$flocking) {unless (&open2(OUT, ">$registry")) {&punt;}}
  327.     else {
  328.         unless (open(OUT, ">$registry")) {&punt;}
  329.         flock OUT, 2;
  330.         }
  331.  
  332.     foreach (@people){
  333.         ($thiscode) = split(/\t/);
  334.         if($thiscode =~ /event/i) {next;}
  335.         $save=1;
  336.         foreach $del (@deletecodes) {
  337.             if ($thiscode eq $del) {$save = 0;}
  338.             }
  339.         if($save && $okcodes[0]){
  340.             $save=0;
  341.             foreach $ok (@okcodes) {
  342.                 if($thiscode eq $ok) {$save=1 ;}
  343.                 }
  344.             }
  345.         if($save) {print OUT $_;}
  346.         }
  347.  
  348.     if($flocking) {
  349.         flock OUT, 8;
  350.         close(OUT);
  351.         }
  352.     else {&close2(OUT);}
  353.  
  354.     } # end sub
  355. ########################################################################
  356. sub getevents {
  357.     $paren='';
  358.     if($::debug) {$paren = " ($eventlist)";}
  359.     $missing = "Events database$paren for reading.";
  360.     &db("GETEVENTS: Opening $eventlist");
  361.     if(!$flocking) {
  362.         &open2(IN,$eventlist) || &punt;
  363.         }
  364.     else {
  365.         unless (open(IN,$eventlist)) {&punt;}
  366.         flock IN, 2;
  367.         }
  368.     @events=<IN>;
  369.     if($flocking) {
  370.         flock IN, 8;
  371.         close(IN);
  372.         }
  373.     else {&close2(IN);}
  374.     return(1);
  375.     }
  376. ########################################################################
  377. sub getregistry {
  378.     $paren='';
  379.     if($::debug) {$paren = " ($registry)";}
  380.     $missing = "Registry database$paren for reading.";
  381.     if(!$flocking) {
  382.         &open2(IN,$registry) || &punt;
  383.         }
  384.     else {
  385.         unless (open(IN,$registry)) {&punt;}
  386.         flock IN, 2;
  387.         }
  388.     @people=<IN>;
  389.     if($flocking) {
  390.         flock IN, 8;
  391.         close(IN);
  392.         }
  393.     else {&close2(IN);}
  394.     return(1);
  395.     }
  396. ########################################################################
  397. #
  398. # Encode a string as Base64
  399. # Copyright 1995-1996, Karl Erickson (kae@citilink.com)
  400. # Used with permission
  401.  
  402. sub b64encode {
  403.     &db("B64ENCODE: checkpoint1");
  404.  
  405.     local ($_) = @_;
  406.     local ($chunk);
  407.     local ($result);
  408.     &db("<BR>B64ENCODE: checkpoint2");
  409.  
  410.     $base64_alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
  411.         'abcdefghijklmnopqrstuvwxyz'.
  412.         '0123456789+/';
  413.     $base64_pad = '=';
  414.     &db("B64ENCODE: checkpoint3");
  415.  
  416.     $uuencode_alphabet = q|`!"#$%&'()*+,-./0123456789:;<=>?|.
  417.         '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'; # double that '\\'!
  418.     #    $uuencode_pad = '`';
  419.  
  420.     ($tr_uuencode = ' '.$uuencode_alphabet) =~ s/\\/\\\\/;
  421.     $tr_base64 = 'A'.$base64_alphabet;
  422.     &db("B64ENCODE: checkpoint 4");
  423.  
  424.     # break into chunks of 45 input chars, use perl's builtin
  425.     # uuencoder to convert each chunk to uuencode format,
  426.     # then kill the leading "M", translate to the base64 alphabet,
  427.     # and finally append a newline.
  428.  
  429.     while (s/^((.|\n){45})//) {
  430.  
  431.         $chunk = substr(pack("u", $&), $[+1, 60);
  432.  
  433.         eval qq{
  434.             \$chunk =~ tr|$tr_uuencode|$tr_base64|;
  435.             };
  436.  
  437.         $result .= $chunk . "\n";
  438.         }
  439.     &db("<BR>B64ENCODE: checkpoint 5");
  440.  
  441.     # any leftover chars go onto a shorter line
  442.     # with uuencode padding converted to base64 padding
  443.  
  444.     if ($_ ne '') {
  445.  
  446.         $chunk = substr(pack("u", $_), $[+1,
  447.         int((length($_)+2)/3)*4 - (45-length($_))%3);
  448.         eval qq{
  449.             \$chunk =~ tr|$tr_uuencode|$tr_base64|;
  450.             };
  451.     $result .= $chunk . ($base64_pad x ((60 - length($chunk)) % 4)) . "\n";
  452.         }
  453.  
  454.     # return result
  455.     $result;
  456.     } # end sub b64encode
  457. ########################################################################
  458. ########################################################################
  459. # Activate this subroutine by removing all ##'s (leave all single #'s)
  460. # Then insert the correct IP address and sender address (2 places)
  461. ##sub NTmailit {
  462. ##    # Ref:
  463. ##    #http://www.activestate.com/ActivePerl/docs/Perl-Win32/perlwin32faq4.html
  464. ##    #http://www.geocities.com/SiliconValley/Park/8312/mail.htm
  465. ##    use Net::SMTP;
  466. ##    my $mailto = shift;
  467. ##    my $mailfrom = shift;
  468. ##    my $subject = shift;
  469. ##    $smtp = Net::SMTP->new('180.119.101.125');# connect to SMTP server
  470. ##    $smtp->mail($mailfrom); # sender's address
  471. ##    $smtp->to($mailto);                    # recipient's address
  472. ##    $smtp->data();                          # Start the mail
  473. ##    # Send the header.
  474. ##    $smtp->datasend("To: $mailto\n");
  475. ##    $smtp->datasend("From: $mailfrom\n");
  476. ##    $smtp->datasend("Subject: $subject\n");
  477. ##    $smtp->datasend("\n");
  478. ##    # Send the body.
  479. ##    $smtp->datasend($message);
  480. ##    $smtp->dataend();                       # Finish sending the mail
  481. ##    $smtp->quit;                            # Close SMTP connection
  482. ##    } # end sub NTmailit
  483. ########################################################################
  484. ########################################################################
  485.  
  486. # FOR BLAT USERS...
  487. # Activate this subroutine by removing all ##'s (leave all single #'s)
  488. # THE CALLS TO THIS ROUTINE MUST BE ALTERED TO SUIT THIS USAGE:
  489. # USAGE: &mailit($recipients = shift,$fromsender,$subject,$message);
  490. sub mailit {
  491.     my $recipients = shift;
  492.     my $fromsender = shift;
  493.     my $subject = shift;
  494.     my $message = shift;
  495.  
  496. ## EDIT HERE ##
  497.     $blatfile = ' C:\inetpub\wwwroot\cgi-bin\registrar\blatfile.txt '; 
  498.     $Blatpath = 'c:\winnt\system32\Blat.exe '; 
  499.     $server = 'caexmta2.amd.com'; 
  500. ## END EDIT ##
  501.  
  502.  
  503.     open (BLAT,">$blatfile") || print "Error: cannot send email.<BR>\n";
  504.     print BLAT $message;
  505.     close BLAT;
  506.  
  507.     # GET MESSAGE READY 
  508.  
  509.     $commandline = $Blatpath;
  510.     $commandline .= $blatfile;
  511.     $commandline .= "-s \"$subject\" " if $subject;
  512.     $commandline .= "-t \"$recipients\" " if $recipients;
  513.     $commandline .= "-f $fromsender " if $fromsender;
  514.     $commandline .= "-c $ccaddress " if $ccaddress;
  515.     $commandline .= "-server $server " if $server;
  516.     $commandline .= "-q " unless $db;    # QUIET MODE
  517.  
  518.     # SEND MAIL USING BLAT AND THE SYSTEM COMMAND
  519.  
  520.     system($commandline);
  521.  
  522.     } # end sub mailit
  523.  
  524. 1;
  525.