shift.cgi

   1 #!/usr/bin/perl -w
   2 #!/usr/bin/perl -Tw
   3 # (Text::Template can't do -T, but no user input is used dangerously)
   4 #
   5 # $Id: shift.cgi,v 1.1 2000-05-11 11:27:32 ivan Exp $
   6 #
   7 # Copyright (C) 2000 Adam Gould
   8 # Copyright (C) 2000 Michal Migurski
   9 # Copyright (C) 2000 Ivan Kohler
  10 # All rights reserved.
  11 #
  12 # This program is free software; you can redistribute it and/or modify it under
  13 # the same terms as Perl itself.
  14
  15 ###
  16 # user-servicable parts
  17 ###
  18
  19 $template_file = '/home/ivan/staffsheet/table.html';
  20 $data_directory = '/home/ivan/staffsheet/data';
  21 $mail_smtpserver = 'localhost'; # set blank to disable
  22 $mail_from = 'ivan-misconfigured-shift-from@420.am';
  23 $mail_subject = 'Your shift has been replaced';
  24 @mail_cc = (
  25   'ivan-misconfigured-shift-cc@420.am',
  26   'ivan-misconfigured-shift-cc2@420.am'
  27 );
  28 $mail_footer = <<END;
  29
  30 Sorry, I don't have any more information.  The person who installed the
  31 staff sheet didn't customize this message.
  32
  33 END
  34
  35 ###
  36 # end of user-servicable parts
  37 ###
  38
  39 use strict;
  40 use vars qw( $template_file $data_directory $mail_smtpserver $mail_from
  41              $mail_subject @mail_cc $mail_footer
  42              $cgi $template %shifthash %warning @messages );
  43 use subs qw( form inputbox );
  44 use Fcntl ":flock";
  45 use CGI 2.15;
  46 use CGI::Carp qw(fatalsToBrowser);
  47 use Text::Template;
  48 use Mail::Internet;
  49 use Mail::Header;
  50 use Date::Format;
  51
  52 $cgi = new CGI;
  53
  54 $template = new Text::Template (
  55   TYPE   => 'FILE',
  56   SOURCE => $template_file,
  57 ) or die "Can't create template for $template_file: $Text::Template::ERROR";
  58
  59 # fill in new data if provided
  60 %warning = ();
  61 @messages = ();
  62 if ( $cgi->param() ) {
  63
  64   # kludge - grep for inputbox("field") in template to find valid form fields
  65   # (DON'T get them from form submission - that's insecure!)
  66   open (TEMPLATE_FILE,"<$template_file")
  67     or die "Can't open template for $template_file: $!";
  68   my @form_fields =
  69     map { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\)/; $2 }
  70       #grep { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\)/ }
  71       grep { /inputbox\s*\(\s*([\'\"])(.*)\1\s*\);?\s*\}/ }
  72         <TEMPLATE_FILE>;
  73   close TEMPLATE_FILE;
  74
  75   #changed fields
  76   #foreach $_ ( @form_fields ) {
  77   #  warn "${_}_old undefined!" unless defined $cgi->param($_. '_old');
  78   #  warn "${_}_new undefined!" unless defined $cgi->param($_. '_new');
  79   #}
  80   my @diff_fields =
  81     grep { $cgi->param($_. '_old') ne $cgi->param($_. '_new') } @form_fields;
  82
  83   if ( @diff_fields ) {
  84
  85     local $SIG{HUP} = 'IGNORE';
  86     local $SIG{INT} = 'IGNORE';
  87     local $SIG{QUIT} = 'IGNORE';
  88     local $SIG{TERM} = 'IGNORE';
  89     local $SIG{TSTP} = 'IGNORE';
  90     local $SIG{PIPE} = 'IGNORE';
  91
  92     #open(LOCKFILE,">>$data_directory/.lock")
  93     open(LOCKFILE,"+<$data_directory/.lock")
  94       or open(LOCKFILE,">>$data_directory/.lock")
  95       or die "Can't open $data_directory/.lock: $!";
  96     flock(LOCKFILE,LOCK_EX); #blocks until we have the lock
  97     seek(LOCKFILE, 0, 0);
  98     print LOCKFILE "$$     \n"; #superfluous
  99
 100     get_data();
 101
 102     foreach my $field ( @diff_fields ) {
 103       $shifthash{$field}='' unless defined $shifthash{$field};
 104       if ( $shifthash{$field} eq $cgi->param($field. '_old') ) {
 105         if ( $cgi->param($field. "_new") =~
 106                /\b(\w[\w\-\.\+]*\@(([\w\.\-]+\.)+\w+))\b/
 107              || $cgi->param($field. "_new") =~ /^\s*$/
 108         ) {
 109           open(FILE,">$data_directory/.new.$field")
 110             or die "Can't open file $data_directory/$field: $!";
 111           print FILE $cgi->param($field. "_new");
 112           close FILE;
 113           rename "$data_directory/.new.$field", "$data_directory/$field";
 114           $warning{$field} = '';
 115           if (
 116             $mail_smtpserver
 117             && $shifthash{$field} =~ /\b(\w[\w\-\.\+]*\@(([\w\.\-]+\.)+\w+))\b/
 118           ) {
 119             my $to = $1;
 120             my $header = Mail::Header->new( [
 121               "From: $mail_from",
 122               "To: $to",
 123               "Cc: ". join(", ", @mail_cc),
 124               "Sender: $mail_from",
 125               "Reply-To: $mail_from",
 126               "Date: ". time2str("%a, %d %b %Y %X %z", time),
 127               "Subject: $mail_subject",
 128             ] );
 129             my $msg = Mail::Internet->new(
 130               'Header' => $header,
 131               'Body'   => [ map "$_\n",
 132                 "Hi,",
 133                 "",
 134                 "The \"$field\" shift you signed up for has been changed to",
 135                 '"'. $cgi->param($field. "_new"). '"',
 136                 "",
 137                 split("\n", $mail_footer),
 138               ],
 139             );
 140             #send later - don't want to block on smtp while we have the lock
 141             push @messages, $msg;
 142           }
 143         } else {
 144           $warning{$field} =
 145             "WARNING: you tried to sign up for <B>$field</B>, but your entry ".
 146             "<B>\"". $cgi->param($field. '_new').
 147             "</B>\" does not contain a valid email address."
 148           ;
 149         }
 150       } elsif ( $shifthash{$field} eq $cgi->param($field. '_new') ) {
 151         #somebody else made the same change (or you hit reload); no need to warn
 152         $warning{$field} = '';
 153       } else {
 154         $warning{$field} =
 155           "WARNING: you tried to change <B>$field</B> from \"<B>".
 156           $cgi->param($field. '_old').
 157           "</B>\" to \"<B>".
 158           $cgi->param($field. "_new").
 159           "</B>\", but in the meantime someone changed it to: "
 160         ;
 161       }
 162     }
 163
 164     flock(LOCKFILE,LOCK_UN);
 165     close LOCKFILE;
 166
 167   }
 168
 169 }
 170
 171 get_data();
 172
 173 my $text = $template->fill_in()
 174   or die "Can't fill in template for $template_file: $Text::Template::ERROR";
 175
 176 print $cgi->header, $text;
 177
 178 $ENV{SMTPHOSTS} = $mail_smtpserver;
 179 $ENV{MAILADDRESS} = $mail_from;
 180 foreach my $msg ( @messages ) {
 181   $msg->smtpsend;
 182 }
 183
 184 # subroutines
 185
 186 sub get_data {
 187   opendir DATA_DIR, $data_directory
 188     or die "Can't open directory $data_directory: $!";
 189   %shifthash = map {
 190     open(FILE, "<$data_directory/$_")
 191       or die "Can't open file $data_directory/$_: $!";
 192     my $value = scalar(<FILE>) || '';
 193     close FILE;
 194     chomp $value;
 195     ( $_ => $value );
 196   } grep { ! /^\.{1,2}(lock)?$/ } readdir(DATA_DIR);
 197   closedir DATA_DIR;
 198 }
 199
 200 # subroutines for the template
 201
 202 sub form {
 203  $cgi->start_form;
 204 }
 205
 206 sub inputbox {
 207   my $field = shift;
 208   return $shifthash{$field} || "&nbsp;"
 209     if defined $cgi->param('__MAGIC') && $cgi->param('__MAGIC') eq 'print';
 210   $shifthash{$field}='' unless defined $shifthash{$field};
 211   $warning{$field}='' unless defined $warning{$field};
 212   #"$field ".
 213   $cgi->hidden(
 214     -name    => $field. '_old',
 215     -default => $shifthash{$field},
 216     -force   => 1,
 217   ).
 218   $warning{$field}.
 219   $cgi->textfield(
 220     -name    => $field. '_new',
 221     -default => $shifthash{$field},
 222     -force   => 1,
 223     -size    => 15,
 224   );
 225 }
 226
 227 sub warnings {
 228   join "<BR>", map {
 229     "$warning{$_}<b>$shifthash{$_}</b>"
 230   } grep {
 231     $warning{$_}
 232   } keys %warning;
 233 }
 234