#! /usr/bin/perl -w
use English;
use strict;
use CGI;
use FileHandle;
use HTTP::Date;

use SafeIO;

my $imgdir = 'usrimg/';
my $infofile = $imgdir . 'info.filecook';
my $quota = 40 * 1024 * 1024;
my $opresult = 0;
my $headerprinted = 0;

my %userdata = ( );

my %magic_codes = 
(
  'GIF8[79]a' => 'image/gif',
  chr(0xff).chr(0xd8).chr(0xff).chr(0xe0).chr(0x00).chr(0x10).'JFIF' => 'image/jpeg',
  chr(0x89).'PNG' => 'image/png',
  chr(0xff).chr(0xd8).chr(0xff).chr(0xe1) => 'image/jpeg'
);
my $magic_length = 10;

# hash keyed by id containing:
# 'comment' => comment
# 'filename' => filename
# 'size' => size
# 'mimetype' => mime type
#

my $imgstat;
my $imgstat_changed = 0;

my $q = new CGI;

# ------------ 

sub main
{
  ObtainLock ( $infofile );
  $imgstat = ReadFile ( $infofile, { } );
  GetUserData();

  # ------------------------
  # handle CGI query

  # list cases which need a lock on the info file first


  if($q->param('upload'))
  {
   ensureheader();
   print handle_upload_submission();
  }
  
  if ( $imgstat_changed )
  {
     WriteFile ( $infofile, $imgstat );
  }

  ReleaseLock ( $infofile );
  
  
  # list cases which don't need a lock on the info file

  if($q->param('get') && ($q->param('get') =~ /([0-9]+)/))
  {
    getimage($1);
  }
  elsif($q->param('chg') && ($q->param('chg')=~/^([0-9]+)$/))
  {
    display_imagechange_page($1);
  }
  else
  {
    display_imagelist();
  }

}

# ------------------------

sub ensureheader
{
  my ($text) = @_;

  if($headerprinted)
  {
    return;
  }

  $headerprinted = 1;

  $text or $text = "Image Server";
  print $q->header, $q->start_html($text);
}

sub getimage
{
    my ($id) = @_;
    my $entry = $imgstat->{$id};
	if(!$entry)
	{
	  ensureheader("Error fetching image");
	  ErrorExit ("$id: invalid filename");
	}

    print $q->header(
                        -type=>$entry->{'mimetype'},
                        -expires=>'+1h',
                        "Content-Length"=>$entry->{'size'}
                      );

    ObtainLock ($entry->{'filename'});
	my $fh = OpenFile ($entry->{'filename'});
    my $buffer;
    read ($fh, $buffer, $entry->{'size'});
	CloseFile ($fh);
    ReleaseLock ($entry->{'filename'});

    print $buffer;
	exit(0);
}


sub display_imagechange_page
{
  my ($id) = @_;
  ensureheader('Change image.');
  print '<H1>Change image '.$id.'</H1>';

  print '<BR>';

  my $entry = $imgstat->{$id};

  if ($entry)
  {
    print '<IMG SRC="img.pl?get=' . $id . '">';
    print '<HR>';
	print $entry->{'comment'};
    print 'Size: ' . $entry->{'size'} . ' bytes.<BR>';
    print 'If you are sure you want to change this image, use the form below:<BR>';
    print $q->start_multipart_form;
    print '<BR> File to upload: ';
    print $q->filefield(-name=>'new_image',
			    -default=>'starting value',
			    -size=>50,
			    -maxlength=>255);
    print $q->hidden('id',$id);
    print '<BR>';
    print 'Comment (displayed in image list): ';
    print $q->textfield('comment',$entry->{'comment'},50,80);
    print $q->submit(-name=>'upload', -value=>'Upload new image and/or change comment.');
    print $q->endform;
  }
  else
  {
    print "Sorry! No such image seems to exist.";
  }

  print '<HR><A HREF="img.pl">Back to image list</A>';
  print '<BR><A HREF="wiki.pl">ToothyWiki</A>';
  print $q->end_html;
}

sub get_list_link
{
  my ($start, $numentries, $text) = @_;

  if ($start < 0)
  {
    $start = 0;
  }

  return '<A HREF="img.pl?start=' . $start . 
         '&numentries=' . $numentries . 
		 '">' . $text . '</A>';
}

sub display_imagelist
{
  my $total = 0;
  my $imagecount = 0;
  my $start = 0;
  my $end = 250;

  if ($userdata{'img_numentries'})
  {
    $end = $start + $userdata{'cookie'}->{'img_numentries'};
  }
  else
  {
    $userdata{'img_numentries'} = $end;
  }

  if ($q->param('start') && $q->param('start') =~ /([0-9]+)/)
  {
    $start = $1;
  }

  if ($q->param('numentries') && $q->param('numentries') =~ /([0-9]+)/)
  {
    $end = $start + $1;
    $userdata{'img_numentries'} = $1;
	$userdata{'changed'} = 1;
  }

  ensureheader();

  my $numimages = keys %$imgstat;

  if ($end > $numimages)
  {
    $end = $numimages;
  }

  print get_list_link($start,$userdata{'img_numentries'},"Refresh Page");
  print ' | <A HREF="wiki.pl?ToothyWikiInternals/ImageServer">Image server manual</A>';
  print ' | <A HREF="wiki.pl">ToothyWiki</A>';
  if ($userdata{'id'})
  {
    print ' | ' .$userdata{'id'} . '. ';
  }

  my $linkline = "Showing images " . ( $start + 1 ) . " to $end of $numimages"; # change this when we allow non-numeric IDs.

  if ($start != 0)
  {
    $linkline .= "; show previous " . get_list_link($start-50,50,"50") . " " . 
	                       get_list_link($start-100,100,"100") . " " .
	                       get_list_link($start-250,250,"250");
  }
  
  if ($end < $numimages)
  {
    $linkline .= "; show next " . get_list_link($end,50,"50") . " " . 
	                   get_list_link($end,100,"100") . " " .
	                   get_list_link($end,250,"250");
  }
  
  if($numimages)
  {
    print "<HR>\n<I>$linkline</I>\n<BR><BR>\n";
  }

  foreach my $id (sort {$a <=> $b} keys %$imgstat)
  {
	my $entry = $imgstat->{$id};

    my $iline = '<TABLE><TR><TD>' . 
              $id . ':  ' . $entry->{'comment'} . '</TD>' .
              '<TD>' . $entry->{'size'} . ' bytes. ' . 
          '</TD>';

    $iline .= '<TD><A HREF="img.pl?chg=' . 
          $id .
          '">View/Change</A></TD></TR></TABLE>';
    $total += $entry->{'size'};
    $imagecount++;

    if ( ($imagecount > $start) && ($imagecount <= $end) )
	{
      print $iline;
	}

  }

  print '<I>';
  if($numimages)
  {
    print "<BR>\n$linkline<BR>\n";
  }

  print 'Quota: ' . $quota . ' bytes;' . 
        ' used ' . $total . ' bytes; ' . 
        'remaining ' . ($quota - $total) . ' bytes.<BR>';
  print '</I>';

  print '<HR>';
  print '<H3>Upload a new image: </H3>';
  print $q->start_multipart_form;
  print '<BR> File to upload: ';
  print $q->filefield(-name=>'new_image',
				-default=>'starting value',
				-size=>50,
				-maxlength=>255);
  print '<BR>';
  print 'Comment (displayed in image list): ';
  print $q->textfield('comment','(type a short comment to describe the new image)',50,80);
  print '<BR>';
  print $q->submit(-name=>'upload', -value=>'Upload the new image.');
  print $q->endform;
  print '<BR><HR>';
  print get_list_link($start,$userdata{'img_numentries'},"Refresh Page");
  print ' | <A HREF="wiki.pl?ToothyWikiInternals/ImageServer">Image server manual</A>';
  print ' | <A HREF="wiki.pl">ToothyWiki</A>';
  if ($userdata{'id'})
  {
    print ' | ' .$userdata{'id'} . '. ';
  }
  print $q->end_html;

}


sub set_entry
{
  my ($id, $entry) = @_;
  $imgstat->{$id} = $entry;
  $imgstat_changed = 1;
}

sub calculate_total_size
{
  my $total = 0;

  foreach my $image ( keys %$imgstat )
  {
    $total += $imgstat->{$image}->{'size'};
  }

  return $total;
}

sub make_unique_id
{
  my $id = 1;

  while ( defined ( $imgstat->{$id} ) )
  {
    $id++;
  }

  return $id;
}

sub receive_upload
{

  my ($fh, $newid, $comment, $oldid) = @_;

  my $total = calculate_total_size();
  my $entry = { 'filename' => $imgdir . $newid, 'comment' => $comment };
 
  my $result = '';
  my $magic = '';

  ObtainLock( $entry->{'filename'} );

	  my $ofh = OpenFile($entry->{'filename'}, '>');

	  $entry->{'size'} = read($fh, $magic, $magic_length); 
	  $entry->{'mimetype'} = identify($magic);

	  if($entry->{'mimetype'})
	  {
		 print $ofh $magic;
		 my $buf = '';
		 $entry->{'size'} += read($fh, $buf, 1024); 
		 while ($buf && ($entry->{'size'} < ($quota - $total))) 
		 {
			print $ofh $buf;
			$entry->{'size'} += read($fh, $buf, 1024); 
		 }
		 CloseFile( $entry->{'filename'} );
	  }
	  else
	  {
		 $result .= 'Image upload failed: unknown image type!';
		 CloseFile( $entry->{'filename'} );

		 unlink $entry->{'filename'};
                 $entry->{'size'} = 0;
	  }

  ReleaseLock ( $entry->{'filename'} );
 

  if($entry->{'size'} && ( $entry->{'size'} < ($quota - $total) ))
  {
     if ( $oldid && ( $oldid != $newid ) )
     {
       if( $imgstat->{ $oldid } )
       {
		 ObtainLock ( $imgdir.$newid );
		 ObtainLock ( $imgdir.$oldid );
         rename $imgdir . $newid, $imgdir . $oldid;
		 $entry->{'filename'} = $imgdir . $oldid;
		 set_entry( $oldid, $entry );
         $result .= 'Image ' . $oldid . 
             ' (' . $entry->{'mimetype'} . ') was changed successfully.';
		 ReleaseLock ( $imgdir.$oldid );
		 ReleaseLock ( $imgdir.$newid );
       }
       else
       {
		 ObtainLock ( $imgdir.$newid );
         unlink $imgdir . $newid;
		 ReleaseLock ( $imgdir.$newid );
         $result .= 'Could not change image '.$oldid.': image does not exist.';
       }
     }
     else
     {
       set_entry( $newid, $entry );
       $result .=  'Image '.$newid . 
             ' ('.$entry->{'mimetype'}.') was uploaded successfully.';
     }
   }
   else
   {
     $result .= 'Image upload failed: quota exceeded!';
     ObtainLock ( $imgdir.$newid );
       unlink $imgdir . $newid;
     ReleaseLock ( $imgdir.$newid );
   }
     
  return '<B>' . $result . '</B><BR><HR>';
  
}


sub handle_upload_submission
{
     my $fh = $q->upload('new_image');
     my $got_file = 0;
	 my $oldid = 0;
	 my $newid = make_unique_id();
	 my $comment = 0;

	 my $result = '';

	 if (($q->param('id')) && ($q->param('id') =~ /^([0-9]+)$/) && ($imgstat->{$q->param('id')}))
	 {
	   $oldid = $1;
	   $comment = $imgstat->{$oldid}->{'$comment'};
	 }

     if($q->param('comment'))  
     {
       $comment = $q->param('comment');
	 }

     if($fh) 
     {
	   $result .= receive_upload( $fh, $newid, $comment, $oldid );
     }
     else
     {
       if($comment)  
       {
         if($oldid)
         {
		    $imgstat->{$oldid}->{'comment'} = $comment;
            $imgstat_changed = 1;
		 }
		 else
		 {
		    $result =  "<BR><HR>Couldn't set comment - couldn't find image $oldid.";
		 }
       }
	   else
	   {
         $result =  '<BR><HR>No valid data was sent by the browser.';
	   }
     }
 
     return $result;      
}

sub identify
{
  my ($magic) = @_;
  foreach my $key (keys %magic_codes)
  {
    if($magic =~ /^$key/)
    {
      return $magic_codes{$key};
    }
  }
  return 0;
}


# -- ID and user prefs ------------------------------

sub GetUserData
{
  my $ip = GetRemoteHost(1);
  my %cookie = $q->cookie('ToothyWiki');
  my $id = $ip;

  if ($cookie{'id'})
  {
    $id = 'ToothyWiki user ' . $cookie{'id'};
    $userdata{'cookie'} = \%cookie;
  }

  $userdata{'id'} = $id;
}

# ---------------------------------------------------

&main();