#!/usr/bin/perl5 -w
# File: append		-*- Perl -*- 
# Created by: Alex (wtwf.com) Wed Aug 16 11:40:02 1995
# Last Modified: Time-stamp: <Tue Dec  9 12:39:15 PST 2003> 
# RCS $Id: append,v 1.9 2004/03/24 22:58:51 ark Exp $ 

# this file appends form info to a file specified by the form

# we'll let the log file get to 20k before it's considered too big.
$maxfilesize=40000;

$arkHOME=(getpwnam('ark'))[7];
unshift(@INC,"$arkHOME/lib/perl/");
$dir="$arkHOME/html/scripts/logs/";

use Socket;
require "cgi-lib2.pl";
require "ark-lib.pl";

@ignoredheaders=("file","thanks","insert","ignored","debug",
		 "mailto","mailsubject", "mailfrom", "wanted",
		 "listproc", "listproclist", "mailname",
		 );

$extraInfo="";

MAIN:
{
  &ARKerror("This script can only be run from authorized servers\n".
	    "$ENV{'HTTP_REFERER'} is not on a valid webserver\n") 
    unless &allowedpage($ENV{'HTTP_REFERER'});

  &ARKerror("Stop abusing this form!") if( $ENV{'REMOTE_ADDR'}=~/(62.13.42.50|210.214.114.146)/);
  
  &ReadParse(*input);

  &ARKprint_header()   if( defined( $input{'debug'} ));

  # add the ignored headers to the list
  if( defined($input{'ignored'}) && $input{'ignored'} =~ /\S+/ ){
    push(@ignoredheaders, split( /,/,  $input{'ignored'}));
  }

  $ignoredheadersstr="(" . join( "|", @ignoredheaders) . ")";
  
  &dofile()     if( defined( $input{'file'}     ));
  &domailto()   if( defined( $input{'mailto'}   ));
  &dolistproc() if( defined( $input{'listproc'} ));

  # send out the thanks
  if( defined($input{'thanks'}) && $input{'thanks'} =~ /\S+/ ){
    &ARKrelocate( &ARKjoinURL($ENV{'HTTP_REFERER'},
			      $input{'thanks'} . 
			      ($input{'listprocaction'}? 
			       '#'.$input{'listprocaction'} : '')
			      ));
  } else {
    &ARKprint_header();
    &ARKprint_title("Thank You");
    
    print <<"EOF_CHEERS";
    <P>Thanks for the random info!</P>
      $extraInfo
      <P>I don't know what it was for, but cheers,
  it has been put to great use!</P>
EOF_CHEERS
    #'
    &ARKprint_back();
    
    &ARKprint_sig();
    &ARKprint_end();
  }
}

sub allowedpage
{
  my( $url ) = @_;
  
  return ($url && $url =~ m!^(
			    http://(\w+\.)*stealthair.com/ 	 |
			    http://(\w+\.)*rageMTB.com/      |
			    http://(\w+\.)*noAttitude.com/       |
			    http://(\w+\.)*wtwf.com/       |
			    http://(\w+\.)*bungeezone.com/   |
			    http://(\w+\.)*bloodyh?eck.com/  |
			    http://(\w+\.)*emailsol.com/ |
			    http://(\w+\.)*boldfish.com/ |
			    http://(\w+\.)*tardis.ed.ac.uk/  )!ix);
}

sub dofile
{
  &ARKerror("No Output File Specified")       unless defined($input{'file'});
  &ARKerror("Could not read destination dir") unless -x $dir;
  
  # are we running from the bungee add club listing
  $bungee=1 if( $input{'file'} =~ /bungee/ );
  
  $file=$dir . $input{'file'};
  
  &ARKdodgy_filename($file);
  
  $ino=(stat($file))[1];
  $size=(stat(_))[7];

  &ARKerror("Something's wrong with the file you're writing to : $file") unless
    (defined( $input{'debug'}) || 
     (($ino!=0) && (-w $file) && ($size<$maxfilesize)) );
  
  # build up the string to add in $toinsert
  $toinsert="";
  
  if( $input{'wanted'} && $input{'wanted'}=~/\S+/ ){
    @entries=split(/:/, $input{'wanted'});
  } else {
    @entries=sort keys(%input);
  }
  print "Entries is \n", join(",", @entries) if defined( $input{'debug'});
  
  foreach $thing (@entries){
    next if($input{$thing} !~ /\S+/ || 
	    $thing =~ /^$ignoredheadersstr$/ );
    
    if( $bungee ){
      if( $thing eq 'Type' ){
	next if $input{$thing} =~ /Select/i;
	$input{$thing} =  $input{'othertype'}  if($input{$thing} =~ /Other/i &&
						  $input{'othertype'}  &&
						  $input{'othertype'} =~/\S+/);
	if( $input{'Height'}  &&  $input{'Height'} =~ /\S+/ ){
	  $input{$thing} .= " (". $input{'Height'} ." ". $input{'Units'} .")";
	}
      } elsif( $thing eq 'Address' ){
	$input{$thing} .= " $input{'Continent'}";
      }
    }
    
    $_= $input{$thing};
    # if I wanted to remove junk at end of line.... s/[\s\n]*$//m;
    $toinsert .="<TR><TH ALIGN=LEFT" . 
      ((length()>80 || /\n\s*\n/m ) ? " VALIGN=TOP" : "")
	. ">$thing:</TH>\n";
    s/&/&amp;/g;	# htmlise some common characters
    s/</&lt;/g;		
    s/>/&gt;/g;
    s/\n\s*\n/<BR>/gm;
    # turn URL's into links '
    s/^www\./http:\/\/www\./g;
    s/((http|news|ftp):(\/\/)?[^\s\)\]>\"\']+)/<A HREF=\"$1\">$1<\/A>/g;
    # turn emails into links too! ' "
    s/([\w_\.-]+\@[\w_-]+\.\w+[\w\._-]*)/<A HREF=\"mailto:$1\">$1<\/A>/g; #"
    $toinsert .="<TD>$_<BR></TD></TR>\n";
  }
  return unless $toinsert=~/\S+/;	# nothing to add!
  
  $addr=&ARKstrangers_name();
  # $addr=~s/(\w+\@\w+\.\w+[\w\.]*)/<A HREF=\"mailto:$1\">$1<\/a>/g; #"

  if( $bungee ){
    $timestr=('Jan','Feb','Mar','Apr','May','Jun',
	      'Jul','Aug','Sep','Oct','Nov','Dec')[(localtime)[4]] . " " .
		(1900+(localtime)[5]);
  } else {
    $timestr=localtime;
  }
  $toinsert =  "<hr><!-- --------------------------------------------- -->\n".
    "<TABLE>\n$toinsert\n<TR><TH ALIGN=LEFT>Date:</TH><TD><!-- $addr --> $timestr</TD></TR>\n".
      "</TABLE>\n";
  
  if( defined( $input{'debug'} )){
    &ARKerror("<H1>Debug:</H1>$toinsert",0,0,0);
    print "Done do_file<BR>\n";
    return;
  }
  
  if(defined($input{'insert'})){
    open(LOG,"<$file")  || &ARKerror("Failed open $file for reading : $!");
    
    $filetxt="";
    $filetxt .= $_ while(<LOG>);
    close(LOG);
    
    # do insert
    if( $filetxt =~ /<!--\s*APPEND\s*-->/ ){
      if( $input{'insert'} =~/before/ ){
	$filetxt =~ s/(<!--\s*APPEND\s*-->)/$toinsert$1/;
      } else {
	$filetxt =~ s/(<!--\s*APPEND\s*-->)/$1$toinsert/;
      }
    } else {
      $filetxt .= $toinsert;
    }
    
    if( -l $file ){
      my $oldfile=$file;
      $file=readlink $file;
      $file=$oldfile if( ! -w $file );
    }
    
    open( LOG,">$file") || &ARKerror("Failed open $file for writing : $!");
    print LOG $filetxt;
    close(LOG);
  } else {
    open( LOG,">>$file")|| &ARKerror("Failed open $file for append : $!");
    print LOG $toinsert;
    close LOG;
  }
}

sub domailto
{
  local($sendmail)=$sendmail || '/usr/lib/sendmail';
  local( $to,$from,$subj, $bcc, $cc );
  
  &ARKerror("No sendmail program in $sendmail") unless -x $sendmail;
  
  # don't you just love perl!
  # this is a security risk, sorry $input{$input{'mailto'}}       ||
  $to=$input{'mailto'} || "alex\@ed.ac.uk";
  
  # turn ^ into @ for my parranoia
  $to =~ s/\^|\&\#064;?/\@/g;
  
  $cc=$input{'mailcc'};
  $cc =~ s/\^|\&\#064;?/\@/g  if( $cc );
  
  $bcc=$input{'mailbcc'};
  $bcc =~ s/\^|\&\#064;?/\@/g  if( $bcc );
  
  $extraInfo="<P>Bcc is $bcc</P>";
  
  $from=$input{$input{'mailfrom'}}   || $input{'mailfrom'}   ||
    "someuser\@$ENV{'REMOTE_ADDR'}";
  $subj=$input{$input{'mailsubject'}}|| $input{'mailsubject'}||
    "Web: $ENV{'HTTP_REFERER'}";
  
  if( defined( $input{'debug'} )){
    print "<PRE>\n";
    print "Sending mail to $to\n";
    print "Sending mail from $from\n";
    print "Sending mail subj $subj\n";
    print "</PRE>\n";
  }
  &verify_emails( $to );

  #Open pipe to the mail program
  open( MAIL, "|$sendmail -t") || &ARKerror("Can't open $sendmail : $!");
  print MAIL  "To: $to\n";
  print MAIL  "CC: $cc\n"   if( $cc  );
  print MAIL  "BCC: $bcc\n" if( $bcc );
  print MAIL  "From: $from\n";
  print MAIL  "Subject: $subj\n";
  if( ! $input{'mailsecret'} ){
    print MAIL  "X-URL: $ENV{'HTTP_REFERER'}\n";
    print MAIL  "X-SOURCE: " . &ARKstrangers_name() . "\n";
    print MAIL  "X-Browser: " . $ENV{'HTTP_USER_AGENT'} . "\n\n";
  }
  
  if( $input{'mailbody'} ){
    print MAIL &sanitize($input{'mailbody'});
  } else {
    foreach $thing (sort keys(%input)){
      next if($input{$thing} !~ /\S+/ || 
	      $thing =~ /^$ignoredheadersstr$/ );
      print MAIL &sanitize(sprintf("%10s : %s\n",$thing,$input{$thing}));
    }
  }
  close(MAIL);
}

sub sanitize
{
  my($body)=@_;

  $body=~s/\@/-at-/g;
  $body=~s/cc:/c-c:/gi;
  $body=~s/to:/t-o:/gi;

  return $body;
}

sub verify_emails
{
  local(@arr)=split(/[\s,]+/,$_[0]);
  local($thing);

  &ARKerror("Invalid email address",1,0) unless @arr;
  
  foreach $thing (@arr) {
    &ARKerror("\"$thing\": does not look like a valid email",1,0) unless 
      $thing =~ /^[\w\._+-]+\@\w+[\w_-]*\.\w+(\.\w+)*/;
  }
}

sub dolistproc
{
  local($sendmail)=$sendmail || '/usr/lib/sendmail';
  local( $to,$from,$name,$subj,$mesg, $action  );
  
  $action= $input{'listprocaction'} || "Subscribe";
  
  return  if( $action =~ /nothing/i );
  
  &ARKerror("No sendmail program in $sendmail") unless -x $sendmail;
  
  # don't you just love perl!
  # this is a security risk, sorry $input{$input{'mailto'}}       ||
  $to=$input{'listproc'} || "alex\@ed.ac.uk";
  $from=$input{$input{'mailfrom'}}   || $input{'mailfrom'}   || 
    &ARKerror("No email address specified!");
  $subj=$input{$input{'mailsubject'}}|| $input{'mailsubject'}||
    "Web: $ENV{'HTTP_REFERER'}";
  
  $name=$input{$input{'mailname'}}   || $input{'mailname'} || "Johnny No Name";
  
  &ARKerror("No listproc list specified!") unless $input{'listproclist'};
  
  
  if( $action =~ /(digest|postpone|normal|ack|noack)/i ){
    $action='ACK' if( $action =~/normal/i );
    $mesg="set $input{'listproclist'} mail $action\n";
  } else {
    $mesg="$action $input{'listproclist'} $name\n";
  }
  
  if( defined( $input{'debug'} )){
    print "<PRE>\n";
    print "Sending mail to   $to\n";
    print "Sending mail from $from\n";
    print "Sending mail subj $subj\n";
    print "Sending mail body $mesg\n";
    print "</PRE>\n";
  }
  &verify_emails( $to );
  &verify_emails( $from );

  #Open pipe to the mail program
  open( MAIL, "|$sendmail -t") || &ARKerror("Can't open $sendmail : $!");
  print MAIL  "To: $to\n";
  print MAIL  "From: $from\n";
  print MAIL  "Subject: $subj\n";
  print MAIL  "X-URL: $ENV{'HTTP_REFERER'}\n";
  print MAIL  "X-SOURCE: " . &ARKstrangers_name() . "\n\n";
  print MAIL  $mesg;
  
  close(MAIL);
}