#!/usr/bin/perl -wT -I.
#
# TWiki WikiClone (see $wikiversion in wiki.pm for version)
#
# Copyright (C) 1999 Peter Thoeny, peter.thoeny@takefive.com ,
# TakeFive Software Inc.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details, published at
# http://www.gnu.ai.mit.edu/copyleft/gpl.html
use CGI;
use wiki;
$query = new CGI;
##### for debug only: Remove next 3 comments (but redirect does not work)
#open(STDERR,'>&STDOUT'); # redirect error to browser
#$| = 1; # no buffering
#print "Content-type: text/html\n\n";
&main();
# =========================
sub filenameToIcon
{
my( $fileName ) = @_;
my @bits = ( split( /\./, $fileName ) );
my $fileExt = lc $bits[$#bits];
my $tmp = &wiki::getPubDir();
my $iconDir = "$tmp/icn";
my $iconUrl = "%PUBURLPATH%/icn";
my $iconList = &wiki::readFile( "$iconDir/_filetypes.txt" );
foreach( split( /\n/, $iconList ) ) {
@bits = ( split( / / ) );
if( $bits[0] eq $fileExt ) {
return "";
}
}
return "";
}
# =========================
sub updateAttachment
{
my ( $atext, $fileName, $filePath, $fileSize, $fileDate, $fileUser, $fileComment ) = @_;
my $atTable = &wiki::readTemplate( "attachtable" );
my ( $atTableBefore, $atTableFile, $atTableAfter ) = split( /%REPEAT%/, $atTable );
my $before="", $item="", $lcItem="", $after="", $set="", $ins="", $comp="";
my $lcFileName = lc $fileName;
my $fileIcon = filenameToIcon( $fileName );
my $result = $atTableBefore;
my $found = 0;
foreach( split( //, $atext ) ) {
$set = $_;
( $before, $item, $after ) = split( /<(?:\/)*TwkFileName>/, $set );
if( $item ) {
$set = "$set";
$lcItem = lc $item;
$comp = ( $lcItem cmp $lcFileName );
if( $comp == 0 ) {
# identical, so replace entry
$found = 1;
$set = $atTableFile;
$set =~ s/%FILEICON%/$fileIcon/go;
$set =~ s/%FILENAME%/$fileName/go;
$set =~ s/%FILEPATH%/$filePath/go;
$set =~ s/%FILESIZE%/$fileSize/go;
$set =~ s/%FILEDATE%/$fileDate/go;
$set =~ s/%FILEUSER%/$fileUser/go;
$set =~ s/%FILECOMMENT%/$fileComment/go;
} elsif( ( $comp > 0 ) && ( ! $found ) ) {
# insert in alphabetical order
$found = 1;
$ins = $atTableFile;
$ins =~ s/%FILEICON%/$fileIcon/go;
$ins =~ s/%FILENAME%/$fileName/go;
$ins =~ s/%FILEPATH%/$filePath/go;
$ins =~ s/%FILESIZE%/$fileSize/go;
$ins =~ s/%FILEDATE%/$fileDate/go;
$ins =~ s/%FILEUSER%/$fileUser/go;
$ins =~ s/%FILECOMMENT%/$fileComment/go;
$result = "$result$ins";
}
# copy existing entry
$result = "$result$set";
}
}
if( ! $found ) {
# add entry
$ins = $atTableFile;
$ins =~ s/%FILEICON%/$fileIcon/go;
$ins =~ s/%FILENAME%/$fileName/go;
$ins =~ s/%FILEPATH%/$filePath/go;
$ins =~ s/%FILESIZE%/$fileSize/go;
$ins =~ s/%FILEDATE%/$fileDate/go;
$ins =~ s/%FILEUSER%/$fileUser/go;
$ins =~ s/%FILECOMMENT%/$fileComment/go;
$result = "$result$ins";
}
$result = "$result$atTableAfter";
return $result;
}
# =========================
# code fragment to extract pixel size from images
# taken from http://www.tardis.ed.ac.uk/~ark/wwwis/
# subroutines: imgsize, gifsize, OLDgifsize, gif_blockskip,
# NEWgifsize, jpegsize
#
# looking at the filename really sucks I should be using the first 4 bytes
# of the image. If I ever do it these are the numbers.... (from chris@w3.org)
# PNG 89 50 4e 47
# GIF 47 49 46 38
# JPG ff d8 ff e0
# XBM 23 64 65 66
# =========================
sub imgsize {
my( $file ) = shift @_;
my( $x, $y) = ( 0, 0 );
if( defined( $file ) && open( STRM, "<$file" ) ) {
binmode( STRM ); # for crappy MS OSes - Win/Dos/NT use is NOT SUPPORTED
if( $file =~ /\.jpg$/i || $file =~ /\.jpeg$/i ) {
( $x, $y ) = &jpegsize( \*STRM );
} elsif( $file =~ /\.gif$/i ) {
( $x, $y ) = &gifsize(\*STRM);
}
close( STRM );
}
return( $x, $y );
}
# =========================
sub gifsize
{
my( $GIF ) = @_;
if( 0 ) {
return &NEWgifsize( $GIF );
} else {
return &OLDgifsize( $GIF );
}
}
# =========================
sub OLDgifsize {
my( $GIF ) = @_;
my( $type, $a, $b, $c, $d, $s ) = ( 0, 0, 0, 0, 0, 0 );
if( defined( $GIF ) &&
read( $GIF, $type, 6 ) &&
$type =~ /GIF8[7,9]a/ &&
read( $GIF, $s, 4 ) == 4 ) {
( $a, $b, $c, $d ) = unpack( "C"x4, $s );
return( $b<<8|$a, $d<<8|$c );
}
return( 0, 0 );
}
# =========================
# part of NEWgifsize
sub gif_blockskip {
my ( $GIF, $skip, $type ) = @_;
my ( $s ) = 0;
my ( $dummy ) = '';
read( $GIF, $dummy, $skip ); # Skip header (if any)
while( 1 ) {
if( eof( $GIF ) ) {
#warn "Invalid/Corrupted GIF (at EOF in GIF $type)\n";
return "";
}
read( $GIF, $s, 1 ); # Block size
last if ord( $s ) == 0; # Block terminator
read( $GIF, $dummy, ord( $s ) ); # Skip data
}
}
# =========================
# this code by "Daniel V. Klein"
sub NEWgifsize {
my( $GIF ) = @_;
my( $cmapsize, $a, $b, $c, $d, $e ) = 0;
my( $type, $s ) = ( 0, 0 );
my( $x, $y ) = ( 0, 0 );
my( $dummy ) = '';
return( $x,$y ) if( !defined $GIF );
read( $GIF, $type, 6 );
if( $type !~ /GIF8[7,9]a/ || read( $GIF, $s, 7 ) != 7 ) {
#warn "Invalid/Corrupted GIF (bad header)\n";
return( $x, $y );
}
( $e ) = unpack( "x4 C", $s );
if( $e & 0x80 ) {
$cmapsize = 3 * 2**(($e & 0x07) + 1);
if( !read( $GIF, $dummy, $cmapsize ) ) {
#warn "Invalid/Corrupted GIF (global color map too small?)\n";
return( $x, $y );
}
}
FINDIMAGE:
while( 1 ) {
if( eof( $GIF ) ) {
#warn "Invalid/Corrupted GIF (at EOF w/o Image Descriptors)\n";
return( $x, $y );
}
read( $GIF, $s, 1 );
( $e ) = unpack( "C", $s );
if( $e == 0x2c ) { # Image Descriptor (GIF87a, GIF89a 20.c.i)
if( read( $GIF, $s, 8 ) != 8 ) {
#warn "Invalid/Corrupted GIF (missing image header?)\n";
return( $x, $y );
}
( $a, $b, $c, $d ) = unpack( "x4 C4", $s );
$x = $b<<8|$a;
$y = $d<<8|$c;
return( $x, $y );
}
if( $type eq "GIF89a" ) {
if( $e == 0x21 ) { # Extension Introducer (GIF89a 23.c.i)
read( $GIF, $s, 1 );
( $e ) = unpack( "C", $s );
if( $e == 0xF9 ) { # Graphic Control Extension (GIF89a 23.c.ii)
read( $GIF, $dummy, 6 ); # Skip it
next FINDIMAGE; # Look again for Image Descriptor
} elsif( $e == 0xFE ) { # Comment Extension (GIF89a 24.c.ii)
&gif_blockskip( $GIF, 0, "Comment" );
next FINDIMAGE; # Look again for Image Descriptor
} elsif( $e == 0x01 ) { # Plain Text Label (GIF89a 25.c.ii)
&gif_blockskip( $GIF, 12, "text data" );
next FINDIMAGE; # Look again for Image Descriptor
} elsif( $e == 0xFF ) { # Application Extension Label (GIF89a 26.c.ii)
&gif_blockskip( $GIF, 11, "application data" );
next FINDIMAGE; # Look again for Image Descriptor
} else {
#printf STDERR "Invalid/Corrupted GIF (Unknown extension %#x)\n", $e;
return( $x, $y );
}
} else {
#printf STDERR "Invalid/Corrupted GIF (Unknown code %#x)\n", $e;
return( $x, $y );
}
} else {
#warn "Invalid/Corrupted GIF (missing GIF87a Image Descriptor)\n";
return( $x, $y );
}
}
}
# =========================
# jpegsize : gets the width and height (in pixels) of a jpeg file
# Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995
# modified slightly by alex@ed.ac.uk
sub jpegsize {
my( $JPEG ) = @_;
my( $done ) = 0;
my( $c1, $c2, $ch, $s, $length, $dummy ) = ( 0, 0, 0, 0, 0, 0 );
my( $a, $b, $c, $d );
if( defined( $JPEG ) &&
read( $JPEG, $c1, 1 ) &&
read( $JPEG, $c2, 1 ) &&
ord( $c1 ) == 0xFF &&
ord( $c2 ) == 0xD8 ) {
while ( ord( $ch ) != 0xDA && !$done ) {
# Find next marker (JPEG markers begin with 0xFF)
# This can hang the program!!
while( ord( $ch ) != 0xFF ) {
return( 0, 0 ) unless read( $JPEG, $ch, 1 );
}
# JPEG markers can be padded with unlimited 0xFF's
while( ord( $ch ) == 0xFF ) {
return( 0, 0 ) unless read( $JPEG, $ch, 1 );
}
# Now, $ch contains the value of the marker.
if( ( ord( $ch ) >= 0xC0 ) && ( ord( $ch ) <= 0xC3 ) ) {
return( 0, 0 ) unless read( $JPEG, $dummy, 3 );
return( 0, 0 ) unless read( $JPEG, $s, 4 );
( $a, $b, $c, $d ) = unpack( "C"x4, $s );
return( $c<<8|$d, $a<<8|$b );
} else {
# We **MUST** skip variables, since FF's within variable names are
# NOT valid JPEG markers
return( 0, 0 ) unless read( $JPEG, $s, 2 );
( $c1, $c2 ) = unpack( "C"x2, $s );
$length = $c1<<8|$c2;
last if( !defined( $length ) || $length < 2 );
read( $JPEG, $dummy, $length-2 );
}
}
}
return( 0, 0 );
}
# =========================
sub addLinkToEndOfTopic
{
my ( $text, $pathFilename, $fileName, $fileComment ) = @_;
my( $before, $after ) = split( //, $text );
if( ! $after ) { $after = ""; }
my $fileLink = "";
if( $fileName =~ /\.(gif|jpg|jpeg)$/ ) {
if( $fileComment ) {
$fileComment = "
$fileComment ";
}
my( $nx, $ny ) = &imgsize( $pathFilename );
my $imgSize = "";
if( ( $nx > 0 ) && ( $ny > 0 ) ) {
$imgSize = "width=\"$nx\" height=\"$ny\"";
}
$fileLink = "\n $fileComment
\n";
} else {
if( $fileComment ) {
$fileComment = "($fileComment) ";
}
$fileLink = "\n$fileName $fileComment
\n";
}
return "$before$fileLink$after";
}
# =========================
sub main
{
my $thePathInfo = $query->path_info();
my $theRemoteUser = $query->remote_user();
my $theTopic = $query->param( 'topic' );
my $theUrl = $query->url;
( $topic, $webName, $scriptUrlPath, $userName ) =
&wiki::initialize( $thePathInfo, $theRemoteUser, $theTopic, $theUrl );
my $filePath = $query->param( 'filepath' ) || "";
my $fileName = $query->param( 'filename' ) || "";
my $tmpFilename = $query->tmpFileName( $filePath ) || "";
my $fileComment = $query->param( 'filecomment' ) || "";
my $createLink = $query->param( 'createlink' ) || "";
# check if file exists and has non zero size
if( ! -s "$tmpFilename" ) {
my $scriptSuffix = $wiki::scriptSuffix;
print $query->redirect( "$scriptUrlPath/oops$scriptSuffix/$webName/$topic?template=oopsupload¶m1=$fileName" );
return;
}
# cut path from filepath name (Windows "\" and Unix "/" format)
my @pathz = ( split( /\\/, $filePath ) );
my $filetemp = $pathz[$#pathz];
my @pathza = ( split( '/', $filetemp ) );
$fileName = $pathza[$#pathza];
$fileName =~ s/[^A-Za-z0-9_\.\-]//go; # delete special characters
# before save, create directories if not exist
my $pubDir = &wiki::getPubDir();
my $tempPath = "$pubDir/$webName";
if( ! -e "$tempPath" ) {
umask( 0 );
mkdir( $tempPath, 0777 );
}
$tempPath = "$tempPath/$topic";
if( ! -e "$tempPath" ) {
umask( 0 );
mkdir( $tempPath, 0777 );
}
# save uploaded file
my $newFile = "$tempPath/$fileName";
## link( $tmpFilename, $newFile ); # fails, don't know why
`$wiki::cpCmd $tmpFilename $newFile`; # ==> use shell cp
umask( 0027 );
chmod( 0644, $newFile );
# get user name
my $fileUser = &wiki::userToWikiName( $userName );
# get time stamp and file size of uploaded file:
my( $tmp1,$tmp2,$tmp3,$tmp4,$tmp5,$tmp6,$tmp7,$fileSize,$tmp9,
$mtime,$tmp11,$tmp12,$tmp13 ) = "";
( $tmp1,$tmp2,$tmp3,$tmp4,$tmp5,$tmp6,$tmp7,$fileSize,$tmp9,
$mtime,$tmp11,$tmp12,$tmp13 ) = stat $tmpFilename;
my $fileDate = &wiki::formatGmTime( $mtime );
if( $wiki::doLogTopicUpload ) {
# write log entry
&wiki::writeLog( "upload", "$webName.$topic", $fileName );
}
# update topic
$fileDate =~ s/ / /go;
my $text = "", $before="", $atext="", $after="";
$text = &wiki::readTopic( $topic );
# extract attachment section:
( $before, $atext, $after ) = split( //, $text );
if( ! $before ) { $before = ""; }
if( ! $atext ) { $atext = ""; }
$atext = updateAttachment( $atext, $fileName, $filePath, $fileSize,
$fileDate, $fileUser, $fileComment );
if( $createLink ) {
$before = addLinkToEndOfTopic( $before, $newFile, $fileName, $fileComment );
}
$text = "$before$atext";
if( $after ) {
$text .= $after;
}
&wiki::saveTopic( $topic, $text );
# and finally display topic
print $query->redirect( &wiki::viewUrl( $topic ) );
}