1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/lib/TWiki/UI/Upload.pm Sat Jan 26 15:50:53 2008 +0100
1.3 @@ -0,0 +1,279 @@
1.4 +# TWiki Enterprise Collaboration Platform, http://TWiki.org/
1.5 +#
1.6 +# Copyright (C) 1999-2007 Peter Thoeny, peter@thoeny.org
1.7 +# and TWiki Contributors. All Rights Reserved. TWiki Contributors
1.8 +# are listed in the AUTHORS file in the root of this distribution.
1.9 +# NOTE: Please extend that file, not this notice.
1.10 +#
1.11 +# Additional copyrights apply to some or all of the code in this
1.12 +# file as follows:
1.13 +#
1.14 +# This program is free software; you can redistribute it and/or
1.15 +# modify it under the terms of the GNU General Public License
1.16 +# as published by the Free Software Foundation; either version 2
1.17 +# of the License, or (at your option) any later version. For
1.18 +# more details read LICENSE in the root of this distribution.
1.19 +#
1.20 +# This program is distributed in the hope that it will be useful,
1.21 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1.22 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
1.23 +#
1.24 +# As per the GPL, removal of this notice is prohibited.
1.25 +
1.26 +=pod
1.27 +
1.28 +---+ package TWiki::UI::Upload
1.29 +
1.30 +UI delegate for attachment management functions
1.31 +
1.32 +=cut
1.33 +
1.34 +package TWiki::UI::Upload;
1.35 +
1.36 +use strict;
1.37 +use Assert;
1.38 +use Error qw( :try );
1.39 +
1.40 +require TWiki;
1.41 +require TWiki::UI;
1.42 +require TWiki::Sandbox;
1.43 +require TWiki::OopsException;
1.44 +
1.45 +=pod
1.46 +
1.47 +---++ StaticMethod attach( $session )
1.48 +
1.49 +=attach= command handler.
1.50 +This method is designed to be
1.51 +invoked via the =UI::run= method.
1.52 +
1.53 +Generates a prompt page for adding an attachment.
1.54 +
1.55 +=cut
1.56 +
1.57 +sub attach {
1.58 + my $session = shift;
1.59 +
1.60 + my $query = $session->{cgiQuery};
1.61 + my $webName = $session->{webName};
1.62 + my $topic = $session->{topicName};
1.63 +
1.64 + my $fileName = $query->param( 'filename' ) || '';
1.65 + my $skin = $session->getSkin();
1.66 +
1.67 + TWiki::UI::checkWebExists( $session, $webName, $topic, 'attach' );
1.68 +
1.69 + my $tmpl = '';
1.70 + my $text = '';
1.71 + my $meta = '';
1.72 + my $atext = '';
1.73 + my $fileUser = '';
1.74 + my $isHideChecked = '';
1.75 + my $users = $session->{users};
1.76 +
1.77 + TWiki::UI::checkMirror( $session, $webName, $topic );
1.78 +
1.79 + TWiki::UI::checkAccess( $session, $webName, $topic,
1.80 + 'CHANGE', $session->{user} );
1.81 + TWiki::UI::checkTopicExists( $session, $webName, $topic,
1.82 + 'upload files to' );
1.83 +
1.84 + ( $meta, $text ) =
1.85 + $session->{store}->readTopic( $session->{user}, $webName, $topic, undef );
1.86 + my $args = $meta->get( 'FILEATTACHMENT', $fileName );
1.87 + $args = {
1.88 + name => $fileName,
1.89 + attr => '',
1.90 + path => '',
1.91 + comment => ''
1.92 + } unless( $args );
1.93 +
1.94 + if ( $args->{attr} =~ /h/o ) {
1.95 + $isHideChecked = 'checked';
1.96 + }
1.97 +
1.98 + # SMELL: why log attach before post is called?
1.99 + # FIXME: Move down, log only if successful (or with error msg?)
1.100 + # Attach is a read function, only has potential for a change
1.101 + if( $TWiki::cfg{Log}{attach} ) {
1.102 + # write log entry
1.103 + $session->writeLog( 'attach', $webName.'.'.$topic, $fileName );
1.104 + }
1.105 +
1.106 + my $fileWikiUser = '';
1.107 + if( $fileName ) {
1.108 + $tmpl = $session->templates->readTemplate( 'attachagain', $skin );
1.109 + my $u = $args->{user};
1.110 + $fileWikiUser = $users->webDotWikiName($u) if $u;
1.111 + } else {
1.112 + $tmpl = $session->templates->readTemplate( 'attachnew', $skin );
1.113 + }
1.114 + if ( $fileName ) {
1.115 + # must come after templates have been read
1.116 + $atext .= $session->attach->formatVersions( $webName, $topic, %$args );
1.117 + }
1.118 + $tmpl =~ s/%ATTACHTABLE%/$atext/g;
1.119 + $tmpl =~ s/%FILEUSER%/$fileWikiUser/g;
1.120 + $tmpl =~ s/%FILENAME%/$fileName/g;
1.121 + $session->enterContext( 'can_render_meta', $meta );
1.122 + $tmpl = $session->handleCommonTags( $tmpl, $webName, $topic );
1.123 + $tmpl = $session->renderer->getRenderedVersion( $tmpl, $webName, $topic );
1.124 + $tmpl =~ s/%HIDEFILE%/$isHideChecked/g;
1.125 + $tmpl =~ s/%FILEPATH%/$args->{path}/g;
1.126 + $args->{comment} = TWiki::entityEncode( $args->{comment} );
1.127 + $tmpl =~ s/%FILECOMMENT%/$args->{comment}/g;
1.128 +
1.129 + $session->writeCompletePage( $tmpl );
1.130 +}
1.131 +
1.132 +=pod
1.133 +
1.134 +---++ StaticMethod upload( $session )
1.135 +
1.136 +=upload= command handler.
1.137 +This method is designed to be
1.138 +invoked via the =UI::run= method.
1.139 +CGI parameters, passed in $query:
1.140 +
1.141 +| =hidefile= | if defined, will not show file in attachment table |
1.142 +| =filepath= | |
1.143 +| =filename= | |
1.144 +| =filecomment= | comment to associate with file in attachment table |
1.145 +| =createlink= | if defined, will create a link to file at end of topic |
1.146 +| =changeproperties= | |
1.147 +| =redirectto= | URL to redirect to after upload. ={AllowRedirectUrl}= must be enabled in =configure=. The parameter value can be a =TopicName=, a =Web.TopicName=, or a URL. Redirect to a URL only works if it is enabled in =configure=. |
1.148 +
1.149 +Does the work of uploading a file to a topic. Designed to be useable for
1.150 +a crude RPC (it will redirect to the 'view' script unless the
1.151 +'noredirect' parameter is specified, in which case it will print a message to
1.152 +STDOUT, starting with 'OK' on success and 'ERROR' on failure.
1.153 +
1.154 +=cut
1.155 +
1.156 +sub upload {
1.157 + my $session = shift;
1.158 +
1.159 + my $query = $session->{cgiQuery};
1.160 + my $webName = $session->{webName};
1.161 + my $topic = $session->{topicName};
1.162 + my $user = $session->{user};
1.163 +
1.164 + my $hideFile = $query->param( 'hidefile' ) || '';
1.165 + my $fileComment = $query->param( 'filecomment' ) || '';
1.166 + my $createLink = $query->param( 'createlink' ) || '';
1.167 + my $doPropsOnly = $query->param( 'changeproperties' );
1.168 + my $filePath = $query->param( 'filepath' ) || '';
1.169 + my $fileName = $query->param( 'filename' ) || '';
1.170 + if ( $filePath && ! $fileName ) {
1.171 + $filePath =~ m|([^/\\]*$)|;
1.172 + $fileName = $1;
1.173 + }
1.174 +
1.175 + $fileComment =~ s/\s+/ /go;
1.176 + $fileComment =~ s/^\s*//o;
1.177 + $fileComment =~ s/\s*$//o;
1.178 + $fileName =~ s/\s*$//o;
1.179 + $filePath =~ s/\s*$//o;
1.180 +
1.181 + TWiki::UI::checkWebExists( $session, $webName, $topic, 'attach files to' );
1.182 + TWiki::UI::checkTopicExists( $session, $webName, $topic, 'attach files to' );
1.183 + TWiki::UI::checkMirror( $session, $webName, $topic );
1.184 + TWiki::UI::checkAccess( $session, $webName, $topic,
1.185 + 'CHANGE', $user );
1.186 +
1.187 + my $origName = $fileName;
1.188 + my $stream;
1.189 + my ( $fileSize, $fileDate, $tmpFilePath ) = '';
1.190 +
1.191 + unless( $doPropsOnly ) {
1.192 + my $fh = $query->param( 'filepath' );
1.193 + # $fh is both a file name *and* a file handle (see the CGI doc)
1.194 +
1.195 + try {
1.196 + # SMELL: use of undocumented CGI::tmpFileName
1.197 + $tmpFilePath = $query->tmpFileName( $fh );
1.198 + } catch Error::Simple with {
1.199 + # Item5130, Item5133 - Illegal file name, bad path,
1.200 + # something like that
1.201 + throw TWiki::OopsException(
1.202 + 'attention',
1.203 + def => 'zero_size_upload',
1.204 + web => $webName,
1.205 + topic => $topic,
1.206 + params => [ ($filePath || '""') ] );
1.207 + };
1.208 +
1.209 + $stream = $query->upload( 'filepath' );
1.210 + ( $fileName, $origName ) =
1.211 + TWiki::Sandbox::sanitizeAttachmentName( $fileName );
1.212 +
1.213 + # check if upload has non zero size
1.214 + if( $stream ) {
1.215 + my @stats = stat $stream;
1.216 + $fileSize = $stats[7];
1.217 + $fileDate = $stats[9];
1.218 + }
1.219 + unless( $fileSize && $fileName ) {
1.220 + throw TWiki::OopsException(
1.221 + 'attention',
1.222 + def => 'zero_size_upload',
1.223 + web => $webName,
1.224 + topic => $topic,
1.225 + params => [ ($filePath || '""') ] );
1.226 + }
1.227 +
1.228 + my $maxSize = $session->{prefs}->getPreferencesValue(
1.229 + 'ATTACHFILESIZELIMIT' );
1.230 + $maxSize = 0 unless ( $maxSize =~ /([0-9]+)/o );
1.231 +
1.232 + if( $maxSize && $fileSize > $maxSize * 1024 ) {
1.233 + throw TWiki::OopsException(
1.234 + 'attention',
1.235 + def => 'oversized_upload',
1.236 + web => $webName,
1.237 + topic => $topic,
1.238 + params => [ $fileName, $maxSize ] );
1.239 + }
1.240 + }
1.241 + try {
1.242 + $session->{store}->saveAttachment(
1.243 + $webName, $topic, $fileName, $user,
1.244 + {
1.245 + dontlog => !$TWiki::cfg{Log}{upload},
1.246 + comment => $fileComment,
1.247 + hide => $hideFile,
1.248 + createlink => $createLink,
1.249 + stream => $stream,
1.250 + filepath => $filePath,
1.251 + filesize => $fileSize,
1.252 + filedate => $fileDate,
1.253 + tmpFilename => $tmpFilePath,
1.254 + } );
1.255 + } catch Error::Simple with {
1.256 + throw TWiki::OopsException( 'attention',
1.257 + def => 'save_error',
1.258 + web => $webName,
1.259 + topic => $topic,
1.260 + params => [ shift->{-text} ] );
1.261 + };
1.262 + close( $stream ) if $stream;
1.263 +
1.264 + if( $fileName eq $origName ) {
1.265 + $session->redirect(
1.266 + $session->getScriptUrl( 1, 'view', $webName, $topic ), undef, 1 );
1.267 + } else {
1.268 + throw TWiki::OopsException( 'attention',
1.269 + def => 'upload_name_changed',
1.270 + web => $webName,
1.271 + topic => $topic,
1.272 + params => [ $origName, $fileName ] );
1.273 + }
1.274 +
1.275 + # generate a message useful for those calling this script from the command line
1.276 + my $message = ( $doPropsOnly ) ?
1.277 + 'properties changed' : "$fileName uploaded";
1.278 +
1.279 + print 'OK ',$message,"\n";
1.280 +}
1.281 +
1.282 +1;