#! /usr/local/bin/perl

require "support.pl";
use CGI qw/:standard/;

###########################################################################

%form = getMultipartFormData();

#
#  Check form data
#

$userid = $ENV{REMOTE_USER};
ReportError("You are not currently logged in!") unless $userid;

$action = $form{action} || 'write';
$now = getDate();

$type = $form{type};
ReportError("No <B>TYPE</B> specified.") unless $type;
$dir = "$root/$type";
ReportError("Unknown type <B>$type</B>.") unless (-e $dir);

$key = $form{key};
$from = $form{from};
$FROM = ($from && -e "$dir/$from/.data")? "&key=$from": '';

$tfb = $form{tfb} || '';
if ($tfb && ($userid eq $TFB || $userid eq $TFB_admin))
  {$userid = $TFB} else {$tfb = ''};
$tfbdir = $tfb? '.tfb/' : '';

###########################################################################

for ($action) {
  /^write/i        and do {Write(); last};
  /^edit/i         and do {Edit($key); last};
  /^delete/i       and do {Delete($key); last};
  /^restore/i      and do {Restore($key); last};
  /^spellcheck/i   and do {Spellcheck(); last};
  /^preview/i      and do {Preview(); last};
  /^refresh/i      and do {Refresh(); last};
  /^post/i         and do {Post(); last};
  /^save/i         and do {Save($key); last};
  /^add/i          and do {Add($key); last};
  /^remove/i       and do {Remove($key); last};
  /^upload/i       and do {Upload($key); last};
  /^cancel/i       and do {Cancel($key); last};
  /^clear/i        and do {Clear($key); last};
  ReportError("Action <B>$action</B> not defined");
}

###########################################################################

sub Write {
  ShowFile("write",
    "%write%"    => $tfb? "Respond to" : "Write",
    "%type%"     => $type,
    "%Type%"     => ucfirst($type),
    "%key%"      => $key,
    "%from%"     => $from,
    "%FROM%"     => $FROM,
    "%post%"     => "Post",
    "%tfb%"      => $tfb,
    "%title%"    => "",
    "%message%"  => "",
    "%text%"     => " CHECKED",
    "%html%"     => "",
    "%math%"     => "",
    "%files%"    => "",
    "%remove%"   => " DISABLED",
  );
  exit;
}

###########################################################################

sub Edit {
  ReportError("No <B>KEY</B> specified") unless $key;
  Write() if (isTFB() && !(-e "$dir/$key/.data-tfb"));
  my ($otitle,$title,$date,$format,$user,$html,$text) = getMessageData($dir,$key,$tfb);
  my $math = ($format =~ s/ math//);
  verifyUser($user);
  removePreviews();
  my @files = getFiles($key);
  ShowFile("write",
    "%write%"    => $tfb? "Edit Responses to" : "Edit",
    "%type%"     => $type,
    "%Type%"     => ucfirst($type),
    "%key%"      => $key,
    "%from%"     => $from,
    "%FROM%"     => $FROM,
    "%post%"     => "Save",
    "%tfb%"      => $tfb,
    "%title%"    => QuoteHTML($otitle),
    "%message%"  => $text,
    "%text%"     => ($format eq "text")? ' CHECKED' : '',
    "%html%"     => ($format eq "html")? ' CHECKED' : '',
    "%math%"     => $math? ' CHECKED' : '',
    "%files%"    => join("\n<OPTION>","",@files),
    "%remove%"   => (scalar(@files) == 0)? ' DISABLED' : '',
  );
  exit;
}

###########################################################################

sub Delete {
  my $key = shift;
  ReportError("No <B>KEY</B> specified") unless $key;
  if (isTFB() && (-e "$dir/$key/.data-tfb")) {
    unlink "$dir/$key/.data-tfb";
    unlink <$dir/$key/.math-tfb/*>;
    rmdir "$dir/$key/.math-tfb";
    unlink <$dir/$key/.tfb/*>;
    rmdir "$dir/$key/.tfb";
    removePreviews();
    Location("read.cgi?type=$type$FROM");
  } else {
    my ($otitle,$title,$date,$format,$user,$html,$text) = getMessageData($dir,$key);
    verifyUser($user);
    unlink("$admin/deleted/$type/$key") if (-e "$admin/deleted/$type/$key");
    ReportError("Can't move <B>$type/$key</B> to deleted directory:<BR>$!")
      unless rename "$dir/$key", "$admin/deleted/$type/$key";
    ShowFile("deleted",
      "%key%"     => $key,
      "%type%"    => $type,
      "%Type%"    => ucfirst($type),
      "%date%"    => $date,
      "%title%"   => $title,
    );
    exit;
  }
}

###########################################################################

sub Restore {
  my $key = shift;
  ReportError("No <B>KEY</B> specified") unless $key;
  ReportError("Message <B>$type/$key</B> has not been deleted")
    unless (-e "$admin/deleted/$type/$key");
  ReportError("Message <B>$type/$key</B> already exists") if (-e "$dir/$key");
  ReportError("Can't move <B>$type/$key<B> from deleted directory:<BR>$!")
    unless rename "$admin/deleted/$type/$key", "$dir/$key";
  Location("read.cgi?type=$type&key=$key");
}

###########################################################################

sub Cancel {
  my $key = shift;
  if ($key && -e "$dir/$key" && ! -e "$dir/$key/.data") {
    unlink("$admin/deleted/$type/$key") if (-e "$admin/deleted/$type/$key");
    rename "$dir/$key", "$admin/deleted/$type/$key";
  }
  removePreviews();
  Location("read.cgi?type=$type$FROM");
}

###########################################################################

sub Spellcheck {
}

###########################################################################

sub Preview {
  newKey() unless $key;
  my ($title,$message,$format) = getMessage(".preview$tfb");
  my ($name) = getUserData($tfb? $TFB: $ENV{REMOTE_USER});
  my ($last,$first,$rest) = split(",",$name,3);
  $rest = ", $rest" if $rest; $name = "$first $last$rest";
  my $math = ($format =~ s/ math//);
  my @files = getFiles($key);
  ShowFile("preview",
    "%type%"     => $type,
    "%Type%"     => ucfirst($type),
    "%key%"      => $key,
    "%from%"     => $from,
    "%FROM%"     => $FROM,
    "%ptitle%"   => $title? "<CENTER><H2>$title</H2></CENTER>" : '',
    "%preview%"  => $message,
    "%title%"    => QuoteHTML($form{title}),
    "%message%"  => $form{message},
    "%name%"     => $name,
    "%date%"     => $now,
    "%post%"     => $form{post},
    "%tfb%"      => $tfb,
    "%text%"     => ($format eq "text")? ' CHECKED' : '',
    "%html%"     => ($format eq "html")? ' CHECKED' : '',
    "%math%"     => $math? ' CHECKED' : '',
    "%files%"    => join("\n<OPTION>","",@files),
    "%remove%"   => (scalar(@files) == 0)? ' DISABLED' : '',
    "%pid%"      => $pid,
    "%cache%"    => QuoteHTML($cache),
  );
  exit;
}

###########################################################################

sub Post {
  newKey() unless $key;
  Save($key);
}

###########################################################################

sub Save {
  my $key = shift;
  ReportError("No <B>KEY</B> specified") unless $key;
  my ($title,$message,$format) = getMessage(".math$tfb");
  my $otitle = $form{title}; $otitle =~ s/[\r\n\t]/ /g;
  my $omessage = $form{message};
  $omessage =~ s/\r\n?/\n/g; $omessage =~ s/\t/ /g;
  if ($format =~ m/text/i) {$omessage =~ s/  +/ /g; $omessage =~ s/\n\n\n+/\n\n/g}
  chomp($omessage); chomp($message);
  verifyUser($key);
  MakeDirectory("$dir/$key");
  open(KFILE,">$dir/$key/.data$tfb") ||
    ReportError("Can't create <B>$key</B> in <B>$type</B> directory:<BR>$!");
  print KFILE join("\n",$otitle,$title,$now,$format,$userid,),"\n";
  print KFILE scalar(split("\n",$omessage)),"\n",$omessage,"\n",$message,"\n";
  close(KFILE);
  removePreviews();
  Log("$form{post}: $type/$key $tfb");
  Location("read.cgi?type=$type&key=$key");
}

###########################################################################

sub Add {
  newKey() unless $key;
  verifyUser($key);
  RequestFiles();
}

###########################################################################

sub Remove {
  ReportError("No <B>KEY</B> specified") unless $key;
  my @files = $query->param("files");
  Error("You need to select some files to remove.") if (scalar(@files) == 0);
  verifyUser($key);
  foreach my $file (@files) {
    ReportError("Can't remove ".QuoteHTML($file).":<BR>$!")
      unless unlink "$dir/$key/$tfbdir$file";
  }
  Refresh();
}

###########################################################################

sub Upload {
  my $key = shift;
  ReportError("No <B>KEY</B> specified") unless $key;
  my ($file,$name,$m);
  MakeDirectory("$dir/$key");
  foreach my $i (1..$form{count}) {
    $file = $query->upload("file$i"); next unless $file;
    $name = $query->param("name$i");
    if ($name eq "") {
      $name = $file;
      $name =~ s!^./!_!;                    #  no initial dot
      $name =~ s/ /_/g;                     #  use _ for spaces
      $name =~ s!.*[/\\]!!;                 #  remove directory
      $name =~ s/[^-_.a-zA-Z0-9]/_/g;       #  no illegal characters
      $name = "newfile.txt" if $name eq "";
    }
    checkName($name);
    MakeDirectory("$dir/$key/$tfbdir");
    open(DATA,">$dir/$key/$tfbdir$name") || ReportError("Can't create file <B>$name</B>:<BR>$!");
    while ($m=read($file,$buffer,1024)) {print DATA $buffer}
    close(DATA); close($file);
    Error("Error uploading data for <B>$name</B>:<BR>$!") unless defined($m);
  }
  if ($form{submit} =~ m/^(save|post)/i) {Save($key)} else {
    $form{form} = "preview" if ($form{submit} =~ m/^preview/i);
    Refresh();
  }
}

###########################################################################

sub Clear {
  $form{title} = ""; $form{message} = "";
  $form{form} = "write";
  Refresh();
}

###########################################################################
###########################################################################

sub Refresh() {
  if ($form{form} eq "preview") {Preview()} else {
    my @files = getFiles($key);
    ShowFile("write",
      "%write%"    => ($form{post} eq "Post")? "Write" : "Edit",
      "%type%"     => $type,
      "%Type%"     => ucfirst($type),
      "%key%"      => $key,
      "%from%"     => $from,
      "%FROM%"     => $FROM,
      "%post%"     => $form{post},
      "%tfb%"      => $tfb,
      "%title%"    => QuoteHTML($form{title}),
      "%message%"  => $form{message},
      "%text%"     => ($form{format} eq "text")? ' CHECKED' : '',
      "%html%"     => ($form{format} eq "html")? ' CHECKED' : '',
      "%math%"     => $form{math}? ' CHECKED' : '',
      "%files%"    => join("\n<OPTION>","",@files),
      "%remove%"   => (scalar(@files) == 0)? ' DISABLED' : '',
    );
    exit;
  }
}

###########################################################################

sub RequestFiles {
  my @files = (); my $n == 0;
  foreach my $file (@_) {push(@files,getRow($file,++$n))}
  ShowFile(($n > 0)? "upload" : "add",
    "%type%"     => $type,
    "%Type%"     => ucfirst($type),
    "%key%"      => $key,
    "%from%"     => $from,
    "%FROM%"     => $FROM,
    "%post%"     => $form{post},
    "%form%"     => $form{form},
    "%tfb%"      => $tfb,
    "%submit%"   => $action,
    "%title%"    => QuoteHTML($form{title}),
    "%message%"  => QuoteHTML($form{message}),
    "%format%"   => $form{format},
    "%math%"     => $form{math},
    "%files%"    => join("\n",@files),
    "%count%"    => scalar(@files),
    "%pid%"      => $form{pid},
    "%cache%"    => QuoteHTML($form{cache}),
  );
  exit;
}

###########################################################################
###########################################################################

sub getMessage {
  my $subdir = shift;
  my $title = $form{title} || ''; 
  my $format = $form{format} || 'text'; $format .= " math" if $form{math};
  $title =~ s/\s\s+/ /g; $title = '' if $title eq ' ';
  my $message = $form{message} || '';
  $message =~ s/\r\n?/\n/g; $message =~ s/\t/ /g;
  if ($format =~ m/text/i) {$message =~ s/  +/ /g; $message =~ s/\n\n\n+/\n\n/g}
  $message = '' if $message eq ' ';
  $title =~ s/(^\s+|\s+$)//g;
  my @errors = ();
  push(@errors,"You must supply a <B>Title</B>.") unless $title || $tfb;
  push(@errors,"You must supply a <B>Message</B>.") unless $message;
  Error(@errors) if scalar(@errors) > 0;
  processMessage($format,$subdir,$title,$message);
}

###########################################################################

sub processMessage {
  my $format = shift; my $subdir = shift;
  my $title = shift; my $message = shift;
  my @math = (); my @files = (); my @badtags = ();
  my $isMath = ($format =~ m/math/i);
  my $isHTML = ($format =~ m/html/i);
  my $n = 0; my $remake = 1;
  $cache = ""; $pid = $$;
  
  $title = normalizeText($title,$isMath,$isHTML);
  $message = normalizeText($message,$isMath,$isHTML);
  if ($subdir =~ m/preview/i) {
    $cache = join('/',getMath($title),getMath($message)) if $isMath;
    if ($form{pid} && $cache eq $form{cache}) {$pid = $form{pid}; $remake = 0}
  }
  
  ($title,$n)   = processText($subdir,$title,  $isMath,$isHTML,\@math,\@files,\@badtags,0);
  ($message,$n) = processText($subdir,$message,$isMath,$isHTML,\@math,\@files,\@badtags,$n);

  RequestFiles(@files) if (scalar(@files) > 0 && ($action =~ m/^(preview|save)/i));
  Error("Your message includes the following disallowed tag(s):<BR>\n".
        "<UL>\n<LI>&lt;".join("&gt;\n<LI>&lt;",sort(@badtags))."&gt;\n</UL>")
                if (scalar(@badtags) > 0);

  if ($remake) {
    removePreviews() unless ($subdir =~ m/preview/i);
    makeImages($subdir,@math) if (scalar(@math) > 0);
  }
  return ($title,$message,$format);
}

###########################################################################

sub normalizeText {
  my $text = shift; my $isMath = shift; my $isHTML = shift;
  if ($isHTML) {$text =~ s/<!--.*?-->//gs; $text =~ s/<!.*?>//gs}
  if ($isMath) {
    $text =~ s/(^|[^\\])\$\$(.*?[^\\])\$\$/\1\\[\2\\]/gs;
    $text =~ s/(^|[^\\])\$(.*?[^\\])\$/\1\\(\2\\)/gs;
    $text =~ s/\\\$/\$/g;
  }
  return $text;
}

###########################################################################

sub getMath {
  my $text = shift;
  my @math = ($text =~ m/(\\\[.*?\\\]|\\\(.*?\\\))/gs);
  return @math;
}

###########################################################################

sub processText {
  my $subdir = shift; my $otext = shift; my $isMath = shift; my $isHTML = shift;
  my $m_ref = shift; my $f_ref = shift; my $b_ref = shift; my $n = shift;
  my @chunks = ($otext); my @ntext; my $isDisplay; my $m; my $img;
  my $SRC = '(<[a-z0-9]+\s[^>]*(?:SRC|HREF|ARCHIVE)\s*=\s*)(".*?"|.*?)([\s>])';

  @chunks = split(/(\\\[.*?\\\]|\\\(.*?\\\))/s,$otext) if $isMath;
  $isMath = 0;
  foreach my $chunk (@chunks) {
    if ($chunk !~ m/^\\[(\[]\s*\\[)\]]$/s) {
      if ($isMath) {
	push(@{$m_ref},$chunk); $isDisplay = ($chunk =~ m/^\\\[/);
        $chunk =~ s/^..(.*)..$/\1/s;
        $chunk = QuoteHTML($chunk); $img = sprintf("$pid-%03d.gif",++$n);
	push(@ntext,'<DIV ALIGN="CENTER">') if $isDisplay;
	push(@ntext,qq{<IMG SRC="$TFBCON/$type/$key/$subdir/$img" ALT="[$chunk]" ALIGN="CENTER" BORDER="0">});
	push(@ntext,'</DIV>') if $isDisplay;
      } else {
        if ($isHTML) {
          foreach my $tag (@BADTAGS) 
            {push(@{$b_ref},$tag) if ($chunk =~ m!</?$tag[\s>]!i)}
          $chunk =~ s/$SRC/$1.adjustFile($2,$f_ref).$3/igoe;
        } else {
          $chunk = QuoteHTML($chunk);
          $chunk =~ s/\n\s*\n */\n<P>\n/g;
        }
	push(@ntext,$chunk);
      }
    }
    $isMath = !$isMath;
  }
  return (join('',@ntext),$n);
}

###########################################################################

sub makeImages {
  my $subdir = shift; my @math = @_;
  my $separator = '\message{'.$SEPARATOR.'}';
  newKey() unless $key;
  my $texdir = "$dir/$key/$subdir";
  MakeDirectory("$dir/$key");
  MakeDirectory($texdir); unlink <$texdir/*>;

  open(TEX,">$texdir/$pid-.tex") ||
    ReportError("Can't write <B>$type/$key/$subdir/$pid-.tex</B>");
  print TEX
    '\batchmode',"\n",
    '\documentclass{article}',"\n",
    '\usepackage{amsmath,amssymb}',"\n",
    '\pagestyle{empty}',"\n",
    '\begin{document}',"\n",
    $separator,"\n",
    join("\n".'\newpage'."\n".$separator."\n",@math),"\n",
    $separator,"\n",
    '\end{document}',"\n";
  close(TEX);

  my $log = `cd $texdir && $LATEX $pid-.tex 2>&1`;
  if ($?) {
    if (-e "$texdir/$pid-.log") {
      my @blocks = grep(/! /,split(/$SEPARATOR/o,getFile("$texdir/$pid-.log")));
      foreach my $block (@blocks) {
        $block =~ s/^.+?!/!/s;
        $block =~ s/\s\[\d+\s*\]\s*$//s;
        $block = QuoteHTML($block);
      }
      $log = "The relevent section(s) of the log file appear to be:<BR><BR>\n".
	qq{<HR SIZE="3" WIDTH="80%" ALIGN="LEFT"><P>\n<PRE>}.
        join(qq{</PRE>\n<P><HR SIZE="3" WIDTH="80%" ALIGN="LEFT"><P>\n<PRE>},@blocks).
        qq{</PRE>\n<P><HR SIZE="3" WIDTH="80%" ALIGN="LEFT"><P>};
    }
    ReportError("Error running latex on mathematics:<BR><BR>\n$log") if ($?);
  }
  $log = `cd $texdir && $DVIPS -E -S1 -i -o $pid- $pid-.dvi 2>&1`;
  ReportError("Error running dvips on mathematics:<BR><BR>".($log? $log: $?)) if ($?);

  my $n = 0; my $file;
  foreach my $math (@math) {
    $file = sprintf("$pid-%03d",++$n);
    $log = `$PSTOIMG -out $texdir/$file.gif $texdir/$file 2>&1`;
    ReportError("Error converting image $n ".QuoteHTML($math).":<BR><BR>".
      ($log? $log: $?)) if ($?);
   }
   
   unlink <$texdir/$pid-.*>;  # cleanup temporary files
   unlink <$texdir/$pid-???>;
}

###########################################################################

sub adjustFile {
  my $file = shift; my $fref = shift;
  $file =~ s/^"(.*)"$/$1/; $file =~ s/ //g;
  return '""' if $file eq "";
  if ($file !~ m!^([a-z]+:|/)!i) {
    push(@{$fref},checkName($file)) if ($file !~ m!/! && ! -e "$dir/$key/$tfbdir$file");
    $file = "$TFBCON/$type/$key/$tfbdir$file";
  }
  return '"'.$file.'"';
}

###########################################################################

sub checkName {
  my $file = shift;
  Error("File names can't be empty") unless $file;
  Error("File name \"<B>$file</B>\" contains an illegal character")
    if ($file =~ s![^-_.a-zA-Z0-9]!'<FONT COLOR="#00AA00">'.QuoteHTML($&).'</FONT>'!ge);
  my $name = QuoteHTML($file);
  Error("File names can't start with a dot: <B>$name</B>") if ($file =~ m/^\./);
  Error("Uploaded files can't be executable:  <B>$name</B>")
    if ($file =~ m/\.(cgi|php|exe|pl)/i);
  return $file;
}

###########################################################################

sub getRow {
  my $file = shift; my $n = shift;
  return qq{<TR><TD ALIGN="RIGHT"><CODE>$file</CODE>:&nbsp;\n}.
         qq{<INPUT TYPE="HIDDEN" NAME="name$n" VALUE="$file">}.
         qq{<INPUT TYPE="FILE" NAME="file$n" SIZE="30"></TD></TR>};
}

###########################################################################

sub removePreviews {
  return unless $key;
  unlink <$dir/$key/.preview$tfb/*>;
  rmdir "$dir/$key/.preview";
}

###########################################################################

sub getFiles {
  my $key = shift;
  opendir(NAMES,"$dir/$key/$tfbdir") || return();
  my @names = readdir(NAMES);
  closedir(NAMES);
  return sort(grep(/^[^.]/,@names));
}

###########################################################################

sub newKey {
  $key = $now; $key =~ s/:/-/g; $key =~ s/ /./g;
  $key .= ".$$.$userid";
  return $key;
}

###########################################################################

sub verifyUser {
  return if $tfb;
  my $user = shift;
  $user =~ s/^[-\d]+\.[-\d]+\.\d+\.//;
  Error("You are not the author of this message")
    unless ($user eq $userid || $userid eq $administrator);
  $userid = $user;
}

###########################################################################

sub isTFB {
  my $user = $key || ''; $user =~ s/^[-\d]+\.[-\d]+\.\d+\.//;
  return 0 if ($user eq $TFB); #  TFB already owns the message, so not a response
  return 0 unless ($userid eq $TFB || $userid eq $TFB_admin);
  $tfb = '-tfb'; $tfbdir = '.tfb/'; $userid = $TFB;
  return 1;
}

###########################################################################

sub getMultipartFormData {
  my %data;
  $query = new CGI;
  my $id, $value;
  foreach $id ($query->param) {$data{$id} = $query->param($id)}
  return %data;
}

###########################################################################

1;