1 rizwank 1.1 # TWiki Collaboration Platform, http://TWiki.org/
2 #
3 # Copyright (C) 1999-2004 Peter Thoeny, peter@thoeny.com
4 #
5 # For licensing info read license.txt file in the TWiki root.
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License
8 # as published by the Free Software Foundation; either version 2
9 # of the License, or (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details, published at
15 # http://www.gnu.org/copyleft/gpl.html
16 =begin twiki
17
18 ---+ TWiki::UI::Upload
19
20 UI delegate for attachment management functions
21
22 rizwank 1.1 =cut
23 package TWiki::UI::Upload;
24
25 use strict;
26 use TWiki;
27 use TWiki::UI;
28
29 =pod
30
31 ---++ attach( $web, $topic, $query )
32 Perform the functions of an 'attach' URL. CGI parameters are:
33 | =filename= | Name of attachment |
34 | =skin= | Skin to use in presenting pages |
35
36 =cut
37 sub attach {
38 my ( $webName, $topic, $userName, $query ) = @_;
39
40 my $fileName = $query->param( 'filename' ) || "";
41 my $skin = $query->param( "skin" );
42
43 rizwank 1.1 return unless TWiki::UI::webExists( $webName, $topic );
44
45 my $tmpl = "";
46 my $text = "";
47 my $meta = "";
48 my $atext = "";
49 my $fileUser = "";
50
51 my $isHideChecked = "";
52
53 return if TWiki::UI::isMirror( $webName, $topic );
54
55 my $wikiUserName = &TWiki::userToWikiName( $userName );
56 return unless TWiki::UI::isAccessPermitted( $webName, $topic,
57 "change", $wikiUserName );
58
59 return unless TWiki::UI::topicExists( $webName, $topic, "attach" );
60
61 ( $meta, $text ) = &TWiki::Store::readTopic( $webName, $topic );
62 my %args = $meta->findOne( "FILEATTACHMENT", $fileName );
63 %args = ( "attr" => "", "path" => "", "comment" => "" ) if( ! % args );
64 rizwank 1.1
65 if ( $args{"attr"} =~ /h/o ) {
66 $isHideChecked = "checked";
67 }
68
69 # why log attach before post is called?
70 # FIXME: Move down, log only if successful (or with error msg?)
71 # Attach is a read function, only has potential for a change
72 if( $TWiki::doLogTopicAttach ) {
73 # write log entry
74 &TWiki::Store::writeLog( "attach", "$webName.$topic", $fileName );
75 }
76
77 my $fileWikiUser = "";
78 $skin = TWiki::Prefs::getPreferencesValue( "SKIN" ) unless ( $skin );
79 if( $fileName && %args ) {
80 $tmpl = TWiki::Store::readTemplate( "attachagain", $skin );
81 $fileWikiUser = &TWiki::userToWikiName( $args{"user"} );
82 } else {
83 $tmpl = TWiki::Store::readTemplate( "attachnew", $skin );
84 }
85 rizwank 1.1 if ( $fileName ) {
86 # must come after templates have been read
87 $atext .= TWiki::Attach::formatVersions( $webName, $topic, $fileName, %args );
88 }
89 $tmpl =~ s/%ATTACHTABLE%/$atext/go;
90 $tmpl =~ s/%FILEUSER%/$fileWikiUser/go;
91 $tmpl = &TWiki::handleCommonTags( $tmpl, $topic );
92 $tmpl = &TWiki::Render::getRenderedVersion( $tmpl );
93 $tmpl = &TWiki::handleMetaTags( $webName, $topic, $tmpl, $meta );
94 $tmpl =~ s/%HIDEFILE%/$isHideChecked/go;
95 $tmpl =~ s/%FILENAME%/$fileName/go;
96 $tmpl =~ s/%FILEPATH%/$args{"path"}/go;
97 $tmpl =~ s/%FILECOMMENT%/$args{"comment"}/go;
98 $tmpl =~ s/( ?) *<\/?(nop|noautolink)\/?>\n?/$1/gois; # remove <nop> and <noautolink> tags
99 TWiki::writeHeader( TWiki::getCgiQuery() );
100 print $tmpl;
101 }
102
103 # =========================
104 # code fragment to extract pixel size from images
105 # taken from http://www.tardis.ed.ac.uk/~ark/wwwis/
106 rizwank 1.1 # subroutines: _imgsize, _gifsize, _OLDgifsize, _gif_blockskip,
107 # _NEWgifsize, _jpegsize
108 #
109 # looking at the filename really sucks I should be using the first 4 bytes
110 # of the image. If I ever do it these are the numbers.... (from chris@w3.org)
111 # PNG 89 50 4e 47
112 # GIF 47 49 46 38
113 # JPG ff d8 ff e0
114 # XBM 23 64 65 66
115
116
117 # =========================
118 sub _imgsize {
119 my( $file ) = shift @_;
120 my( $x, $y) = ( 0, 0 );
121
122 if( defined( $file ) && open( STRM, "<$file" ) ) {
123 binmode( STRM ); # for crappy MS OSes - Win/Dos/NT use is NOT SUPPORTED
124 if( $file =~ /\.jpg$/i || $file =~ /\.jpeg$/i ) {
125 ( $x, $y ) = &_jpegsize( \*STRM );
126 } elsif( $file =~ /\.gif$/i ) {
127 rizwank 1.1 ( $x, $y ) = &_gifsize(\*STRM);
128 } elsif( $file =~ /\.png$/i ) {
129 ( $x, $y ) = &_pngsize(\*STRM);
130 }
131 close( STRM );
132 }
133 return( $x, $y );
134 }
135
136
137 # =========================
138 sub _gifsize
139 {
140 my( $GIF ) = @_;
141 if( 0 ) {
142 return &_NEWgifsize( $GIF );
143 } else {
144 return &_OLDgifsize( $GIF );
145 }
146 }
147
148 rizwank 1.1
149 # =========================
150 sub _OLDgifsize {
151 my( $GIF ) = @_;
152 my( $type, $a, $b, $c, $d, $s ) = ( 0, 0, 0, 0, 0, 0 );
153
154 if( defined( $GIF ) &&
155 read( $GIF, $type, 6 ) &&
156 $type =~ /GIF8[7,9]a/ &&
157 read( $GIF, $s, 4 ) == 4 ) {
158 ( $a, $b, $c, $d ) = unpack( "C"x4, $s );
159 return( $b<<8|$a, $d<<8|$c );
160 }
161 return( 0, 0 );
162 }
163
164
165 # =========================
166 # part of _NEWgifsize
167 sub _gif_blockskip {
168 my ( $GIF, $skip, $type ) = @_;
169 rizwank 1.1 my ( $s ) = 0;
170 my ( $dummy ) = '';
171
172 read( $GIF, $dummy, $skip ); # Skip header (if any)
173 while( 1 ) {
174 if( eof( $GIF ) ) {
175 #warn "Invalid/Corrupted GIF (at EOF in GIF $type)\n";
176 return "";
177 }
178 read( $GIF, $s, 1 ); # Block size
179 last if ord( $s ) == 0; # Block terminator
180 read( $GIF, $dummy, ord( $s ) ); # Skip data
181 }
182 }
183
184
185 # =========================
186 # this code by "Daniel V. Klein" <dvk@lonewolf.com>
187 sub _NEWgifsize {
188 my( $GIF ) = @_;
189 my( $cmapsize, $a, $b, $c, $d, $e ) = 0;
190 rizwank 1.1 my( $type, $s ) = ( 0, 0 );
191 my( $x, $y ) = ( 0, 0 );
192 my( $dummy ) = '';
193
194 return( $x,$y ) if( !defined $GIF );
195
196 read( $GIF, $type, 6 );
197 if( $type !~ /GIF8[7,9]a/ || read( $GIF, $s, 7 ) != 7 ) {
198 #warn "Invalid/Corrupted GIF (bad header)\n";
199 return( $x, $y );
200 }
201 ( $e ) = unpack( "x4 C", $s );
202 if( $e & 0x80 ) {
203 $cmapsize = 3 * 2**(($e & 0x07) + 1);
204 if( !read( $GIF, $dummy, $cmapsize ) ) {
205 #warn "Invalid/Corrupted GIF (global color map too small?)\n";
206 return( $x, $y );
207 }
208 }
209 FINDIMAGE:
210 while( 1 ) {
211 rizwank 1.1 if( eof( $GIF ) ) {
212 #warn "Invalid/Corrupted GIF (at EOF w/o Image Descriptors)\n";
213 return( $x, $y );
214 }
215 read( $GIF, $s, 1 );
216 ( $e ) = unpack( "C", $s );
217 if( $e == 0x2c ) { # Image Descriptor (GIF87a, GIF89a 20.c.i)
218 if( read( $GIF, $s, 8 ) != 8 ) {
219 #warn "Invalid/Corrupted GIF (missing image header?)\n";
220 return( $x, $y );
221 }
222 ( $a, $b, $c, $d ) = unpack( "x4 C4", $s );
223 $x = $b<<8|$a;
224 $y = $d<<8|$c;
225 return( $x, $y );
226 }
227 if( $type eq "GIF89a" ) {
228 if( $e == 0x21 ) { # Extension Introducer (GIF89a 23.c.i)
229 read( $GIF, $s, 1 );
230 ( $e ) = unpack( "C", $s );
231 if( $e == 0xF9 ) { # Graphic Control Extension (GIF89a 23.c.ii)
232 rizwank 1.1 read( $GIF, $dummy, 6 ); # Skip it
233 next FINDIMAGE; # Look again for Image Descriptor
234 } elsif( $e == 0xFE ) { # Comment Extension (GIF89a 24.c.ii)
235 &_gif_blockskip( $GIF, 0, "Comment" );
236 next FINDIMAGE; # Look again for Image Descriptor
237 } elsif( $e == 0x01 ) { # Plain Text Label (GIF89a 25.c.ii)
238 &_gif_blockskip( $GIF, 12, "text data" );
239 next FINDIMAGE; # Look again for Image Descriptor
240 } elsif( $e == 0xFF ) { # Application Extension Label (GIF89a 26.c.ii)
241 &_gif_blockskip( $GIF, 11, "application data" );
242 next FINDIMAGE; # Look again for Image Descriptor
243 } else {
244 #printf STDERR "Invalid/Corrupted GIF (Unknown extension %#x)\n", $e;
245 return( $x, $y );
246 }
247 } else {
248 #printf STDERR "Invalid/Corrupted GIF (Unknown code %#x)\n", $e;
249 return( $x, $y );
250 }
251 } else {
252 #warn "Invalid/Corrupted GIF (missing GIF87a Image Descriptor)\n";
253 rizwank 1.1 return( $x, $y );
254 }
255 }
256 }
257
258 # =========================
259 # _jpegsize : gets the width and height (in pixels) of a jpeg file
260 # Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995
261 # modified slightly by alex@ed.ac.uk
262 sub _jpegsize {
263 my( $JPEG ) = @_;
264 my( $done ) = 0;
265 my( $c1, $c2, $ch, $s, $length, $dummy ) = ( 0, 0, 0, 0, 0, 0 );
266 my( $a, $b, $c, $d );
267
268 if( defined( $JPEG ) &&
269 read( $JPEG, $c1, 1 ) &&
270 read( $JPEG, $c2, 1 ) &&
271 ord( $c1 ) == 0xFF &&
272 ord( $c2 ) == 0xD8 ) {
273 while ( ord( $ch ) != 0xDA && !$done ) {
274 rizwank 1.1 # Find next marker (JPEG markers begin with 0xFF)
275 # This can hang the program!!
276 while( ord( $ch ) != 0xFF ) {
277 return( 0, 0 ) unless read( $JPEG, $ch, 1 );
278 }
279 # JPEG markers can be padded with unlimited 0xFF's
280 while( ord( $ch ) == 0xFF ) {
281 return( 0, 0 ) unless read( $JPEG, $ch, 1 );
282 }
283 # Now, $ch contains the value of the marker.
284 if( ( ord( $ch ) >= 0xC0 ) && ( ord( $ch ) <= 0xC3 ) ) {
285 return( 0, 0 ) unless read( $JPEG, $dummy, 3 );
286 return( 0, 0 ) unless read( $JPEG, $s, 4 );
287 ( $a, $b, $c, $d ) = unpack( "C"x4, $s );
288 return( $c<<8|$d, $a<<8|$b );
289 } else {
290 # We **MUST** skip variables, since FF's within variable names are
291 # NOT valid JPEG markers
292 return( 0, 0 ) unless read( $JPEG, $s, 2 );
293 ( $c1, $c2 ) = unpack( "C"x2, $s );
294 $length = $c1<<8|$c2;
295 rizwank 1.1 last if( !defined( $length ) || $length < 2 );
296 read( $JPEG, $dummy, $length-2 );
297 }
298 }
299 }
300 return( 0, 0 );
301 }
302
303 # =========================
304 # _pngsize : gets the width & height (in pixels) of a png file
305 # cor this program is on the cutting edge of technology! (pity it's blunt!)
306 # GRR 970619: fixed bytesex assumption
307 # source: http://www.la-grange.net/2000/05/04-png.html
308 sub _pngsize {
309 my ($PNG) = @_;
310 my ($head) = "";
311 my($a, $b, $c, $d, $e, $f, $g, $h)=0;
312 if(defined($PNG) &&
313 read( $PNG, $head, 8 ) == 8 &&
314 $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a" &&
315 read($PNG, $head, 4) == 4 &&
316 rizwank 1.1 read($PNG, $head, 4) == 4 &&
317 $head eq "IHDR" &&
318 read($PNG, $head, 8) == 8 ){
319 ($a,$b,$c,$d,$e,$f,$g,$h)=unpack("C"x8,$head);
320 return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h);
321 }
322 return (0,0);
323 }
324
325 # =========================
326 sub _addLinkToEndOfTopic
327 {
328 my ( $text, $pathFilename, $fileName, $fileComment ) = @_;
329 my $fileLink = "";
330 my $imgSize = "";
331
332 if( $fileName =~ /\.(gif|jpg|jpeg|png)$/i ) {
333 # inline image
334 $fileComment = $fileName if( ! $fileComment );
335 my( $nx, $ny ) = &_imgsize( $pathFilename );
336 if( ( $nx > 0 ) && ( $ny > 0 ) ) {
337 rizwank 1.1 $imgSize = " width=\"$nx\" height=\"$ny\" ";
338 }
339 $fileLink = &TWiki::Prefs::getPreferencesValue( "ATTACHEDIMAGEFORMAT" )
340 || ' * $comment: <br />'
341 . ' <img src="%ATTACHURLPATH%/$name" alt="$name"$size />';
342 } else {
343 # normal attached file
344 $fileLink = &TWiki::Prefs::getPreferencesValue( "ATTACHEDFILELINKFORMAT" )
345 || ' * [[%ATTACHURL%/$name][$name]]: $comment';
346 }
347
348 $fileLink =~ s/^ /\t\t/go;
349 $fileLink =~ s/^ /\t/go;
350 $fileLink =~ s/\$name/$fileName/g;
351 $fileLink =~ s/\$comment/$fileComment/g;
352 $fileLink =~ s/\$size/$imgSize/g;
353 $fileLink =~ s/\\t/\t/go;
354 $fileLink =~ s/\\n/\n/go;
355 $fileLink =~ s/([^\n])$/$1\n/;
356
357 return "$text$fileLink";
358 rizwank 1.1 }
359
360 =pod
361
362 ---++ upload( $web, $topic, $userName, $query)
363 Perform the functions of an 'upload' url.
364 CGI parameters, passed in $query:
365 | =hidefile= | if defined, will not show file in attachment table |
366 | =filepath= | |
367 | =filename= | |
368 | =filecomment= | Comment to associate with file in attachment table |
369 | =createlink= | if defined, will create a link to file at end of topic |
370 | =changeproperties= | |
371
372 =cut
373 sub upload {
374 my ( $webName, $topic, $userName, $query ) = @_;
375
376 my $hideFile = $query->param( 'hidefile' ) || "";
377 my $fileComment = $query->param( 'filecomment' ) || "";
378 my $createLink = $query->param( 'createlink' ) || "";
379 rizwank 1.1 my $doChangeProperties = $query->param( 'changeproperties' );
380 my $filePath = $query->param( 'filepath' ) || "";
381 my $fileName = $query->param( 'filename' ) || "";
382 if ( $filePath && ! $fileName ) {
383 $filePath =~ m|([^/\\]*$)|;
384 $fileName = $1;
385 }
386 my $tmpFilename = $query->tmpFileName( $filePath ) || "";
387 # CODE_SMELL: should really be using the file handle, not
388 # an undocumented CGI function. The previous line of code causes
389 # an Apache warning.
390 #my $tmpFile = $query->upload( "filepath" ) || "";
391
392 $fileComment =~ s/\s+/ /go;
393 $fileComment =~ s/^\s*//o;
394 $fileComment =~ s/\s*$//o;
395
396 close $filePath if( $TWiki::OS eq "WINDOWS");
397
398 # Change Windows path to Unix path
399 $tmpFilename =~ s!\\!/!go;
400 rizwank 1.1 $tmpFilename =~ /(.*)/;
401 $tmpFilename = $1;
402 ##TWiki::writeDebug( "upload: tmpFilename $tmpFilename" );
403
404 my @error =
405 updateAttachment( $webName, $topic, $userName,
406 $createLink,
407 $doChangeProperties,
408 $filePath, $tmpFilename,
409 $fileName, $hideFile, $fileComment );
410
411 if ( ( @error ) && scalar( @error ) && defined( $error[0] )) {
412 # error[0] will be "" if redirect already printed
413 TWiki::UI::oops( $webName, $topic, @error ) if ( $error[0] )
414 } else {
415 # and finally display topic
416 TWiki::UI::redirect( &TWiki::getViewUrl( $webName, $topic ) );
417 my $message = ( $doChangeProperties ) ? "properties changed" : "$fileName uploaded";
418 print( "OK $message\n" );
419 }
420 }
421 rizwank 1.1
422 =pod
423
424 ---++ updateAttachment( $webName, $topic, $userName, $createLink, $propsOnly, $filePath, $localFile, $attName, $hideFile, $comment ) => undef or error
425
426 CODE_SMELL: this should really be in Store
427
428 Update an attachment, file or properties or both. This may also be used to
429 create an attachment.
430 | =$webName= | Web containing topic |
431 | =$topic= | Topic |
432 | =$userName= | Username of user doing upload/change - username, *not* wikiName |
433 | =$createLink= | 1 if a link is to be created in the topic text |
434 | =$propsOnly= | 1 if only change properties, not atachment |
435 | =$filePath= | if !propsOnly, gives the remote path name of the file to upload. This is used to derive the attName. |
436 | =$localFile= | Name of local file to replace attachment |
437 | =$attName= | If propsOnly, the name of the attachment. Ignored if !propsOnly. |
438 | =$hideFile= | (property) on if files is to be hidden in normal view |
439 | =$comment= | (property) comment associated with file |
440 | return | on error, a list of parameters to the TWiki::UI::oops function, not including the webName and topic. |
441 | | If the first element in the list is the empty string, an error has already been printed to the browser, and no oops call is necessary. |
442 rizwank 1.1
443 =cut
444 sub updateAttachment {
445 my ( $webName, $topic, $userName,
446 $createLink,
447 $propsOnly,
448 $filePath, $localFile,
449 $attName, $hideFile, $comment ) = @_;
450
451 my $wikiUserName = TWiki::userToWikiName( $userName );
452 return ( 0 ) unless TWiki::UI::webExists( $webName, $topic );
453 return ( 0 ) if TWiki::UI::isMirror( $webName, $topic );
454 return ( 0 ) unless TWiki::UI::isAccessPermitted( $webName, $topic,
455 "change", $wikiUserName );
456 return ( 0 ) unless TWiki::UI::topicExists( $webName, $topic, "upload" );
457
458 my( $fileSize, $fileUser, $fileDate, $fileVersion ) = "";
459
460 unless( $propsOnly ) {
461 # cut path from filepath name (Windows "\" and Unix "/" format)
462 my @pathz = ( split( /\\/, $filePath ) );
463 rizwank 1.1 my $filetemp = $pathz[$#pathz];
464 my @pathza = ( split( '/', $filetemp ) );
465 $attName = $pathza[$#pathza];
466
467 # Delete unwanted characters from filename, with I18N
468 my $nonAlphaNum = "[^$TWiki::regex{mixedAlphaNum}" . '\._-]+';
469 $attName =~ s/${nonAlphaNum}//go;
470 $attName =~ s/$TWiki::uploadFilter/$1\.txt/goi; # apply security filter
471 $attName =~ /(.*)/; # untaint
472 $attName = $1;
473
474 ##TWiki::writeDebug ("Upload filename after cleanup is '$attName'");
475
476 # check if file exists and has non zero size
477 my $size = -s $localFile;
478
479 if( ! -e $localFile || ! $size ) {
480 return ( "upload",
481 "ERROR $webName.$topic File missing or zero size", $attName );
482 }
483
484 rizwank 1.1 my $maxSize = TWiki::Prefs::getPreferencesValue( "ATTACHFILESIZELIMIT" );
485 $maxSize = 0 unless ( $maxSize =~ /([0-9]+)/o );
486
487 if( $maxSize && $size > $maxSize * 1024 ) {
488 return ( "uploadlimit", $attName, $maxSize );
489 }
490
491 # Update
492 my $text1 = "";
493 my $saveCmd = "";
494 my $doNotLogChanges = 1;
495 my $doUnlock = 0;
496 my $dontNotify = "";
497 my $error =
498 TWiki::Store::saveAttachment( $webName, $topic, $text1, $saveCmd,
499 $attName, $doNotLogChanges, $doUnlock,
500 $dontNotify, $comment, $localFile );
501
502 if ( $error ) {
503 return ( "saveerr", "Save attachment error $error" );
504 }
505 rizwank 1.1
506 # get user name
507 $fileUser = $userName;
508
509 # get time stamp and file size of uploaded file:
510 my @stats = stat $localFile;
511 $fileSize = $stats[7];
512 $fileDate = $stats[9];
513
514 $fileVersion = TWiki::Store::getRevisionNumber( $webName, $topic,
515 $attName );
516
517 if( $TWiki::doLogTopicUpload ) {
518 # write log entry
519 TWiki::Store::writeLog( "upload", "$webName.$topic", $attName );
520 #FIXE also do log for change property?
521 }
522 }
523
524 # update topic
525 my( $meta, $text ) = TWiki::Store::readTopic( $webName, $topic );
526 rizwank 1.1
527 # update meta-data
528 if( $propsOnly ) {
529 TWiki::Attach::updateProperties( $attName, $hideFile, $comment, $meta );
530 } else {
531 TWiki::Attach::updateAttachment( $fileVersion, $attName, $filePath,
532 $fileSize,
533 $fileDate, $fileUser, $comment,
534 $hideFile, $meta );
535 }
536
537 if( $createLink ) {
538 $filePath = TWiki::Store::getFileName( $webName, $topic, $attName );
539 $text = _addLinkToEndOfTopic( $text, $filePath, $attName, $comment );
540 }
541
542 # update topic
543 my $error = TWiki::Store::saveTopic( $webName, $topic, $text, $meta, "", 1 );
544 if( $error ) {
545 return ( "saveerr", "Save topic error $error" );
546 }
547 rizwank 1.1
548 return undef;
549 }
550
551 1;
|
Return to
Upload.pm
CVS log
Up to [RizwankCVS] / geekymedia_web / twiki / lib / TWiki / UI