lib/TWiki/UI/Upload.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
     1 # TWiki Enterprise Collaboration Platform, http://TWiki.org/
     2 #
     3 # Copyright (C) 1999-2007 Peter Thoeny, peter@thoeny.org
     4 # and TWiki Contributors. All Rights Reserved. TWiki Contributors
     5 # are listed in the AUTHORS file in the root of this distribution.
     6 # NOTE: Please extend that file, not this notice.
     7 #
     8 # Additional copyrights apply to some or all of the code in this
     9 # file as follows:
    10 #
    11 # This program is free software; you can redistribute it and/or
    12 # modify it under the terms of the GNU General Public License
    13 # as published by the Free Software Foundation; either version 2
    14 # of the License, or (at your option) any later version. For
    15 # more details read LICENSE in the root of this distribution.
    16 #
    17 # This program is distributed in the hope that it will be useful,
    18 # but WITHOUT ANY WARRANTY; without even the implied warranty of
    19 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    20 #
    21 # As per the GPL, removal of this notice is prohibited.
    22 
    23 =pod
    24 
    25 ---+ package TWiki::UI::Upload
    26 
    27 UI delegate for attachment management functions
    28 
    29 =cut
    30 
    31 package TWiki::UI::Upload;
    32 
    33 use strict;
    34 use Assert;
    35 use Error qw( :try );
    36 
    37 require TWiki;
    38 require TWiki::UI;
    39 require TWiki::Sandbox;
    40 require TWiki::OopsException;
    41 
    42 =pod
    43 
    44 ---++ StaticMethod attach( $session )
    45 
    46 =attach= command handler.
    47 This method is designed to be
    48 invoked via the =UI::run= method.
    49 
    50 Generates a prompt page for adding an attachment.
    51 
    52 =cut
    53 
    54 sub attach {
    55     my $session = shift;
    56 
    57     my $query = $session->{cgiQuery};
    58     my $webName = $session->{webName};
    59     my $topic = $session->{topicName};
    60 
    61     my $fileName = $query->param( 'filename' ) || '';
    62     my $skin = $session->getSkin();
    63 
    64     TWiki::UI::checkWebExists( $session, $webName, $topic, 'attach' );
    65 
    66     my $tmpl = '';
    67     my $text = '';
    68     my $meta = '';
    69     my $atext = '';
    70     my $fileUser = '';
    71     my $isHideChecked = '';
    72     my $users = $session->{users};
    73 
    74     TWiki::UI::checkMirror( $session, $webName, $topic );
    75 
    76     TWiki::UI::checkAccess( $session, $webName, $topic,
    77                             'CHANGE', $session->{user} );
    78     TWiki::UI::checkTopicExists( $session, $webName, $topic,
    79                                  'upload files to' );
    80 
    81     ( $meta, $text ) =
    82       $session->{store}->readTopic( $session->{user}, $webName, $topic, undef );
    83     my $args = $meta->get( 'FILEATTACHMENT', $fileName );
    84     $args = {
    85              name => $fileName,
    86              attr => '',
    87              path => '',
    88              comment => ''
    89             } unless( $args );
    90 
    91     if ( $args->{attr} =~ /h/o ) {
    92         $isHideChecked = 'checked';
    93     }
    94 
    95     # SMELL: why log attach before post is called?
    96     # FIXME: Move down, log only if successful (or with error msg?)
    97     # Attach is a read function, only has potential for a change
    98     if( $TWiki::cfg{Log}{attach} ) {
    99         # write log entry
   100         $session->writeLog( 'attach', $webName.'.'.$topic, $fileName );
   101     }
   102 
   103     my $fileWikiUser = '';
   104     if( $fileName ) {
   105         $tmpl = $session->templates->readTemplate( 'attachagain', $skin );
   106         my $u = $args->{user};
   107         $fileWikiUser = $users->webDotWikiName($u) if $u;
   108     } else {
   109         $tmpl = $session->templates->readTemplate( 'attachnew', $skin );
   110     }
   111     if ( $fileName ) {
   112         # must come after templates have been read
   113         $atext .= $session->attach->formatVersions( $webName, $topic, %$args );
   114     }
   115     $tmpl =~ s/%ATTACHTABLE%/$atext/g;
   116     $tmpl =~ s/%FILEUSER%/$fileWikiUser/g;
   117     $tmpl =~ s/%FILENAME%/$fileName/g;
   118     $session->enterContext( 'can_render_meta', $meta );
   119     $tmpl = $session->handleCommonTags( $tmpl, $webName, $topic );
   120     $tmpl = $session->renderer->getRenderedVersion( $tmpl, $webName, $topic );
   121     $tmpl =~ s/%HIDEFILE%/$isHideChecked/g;
   122     $tmpl =~ s/%FILEPATH%/$args->{path}/g;
   123     $args->{comment} = TWiki::entityEncode( $args->{comment} );
   124     $tmpl =~ s/%FILECOMMENT%/$args->{comment}/g;
   125 
   126     $session->writeCompletePage( $tmpl );
   127 }
   128 
   129 =pod
   130 
   131 ---++ StaticMethod upload( $session )
   132 
   133 =upload= command handler.
   134 This method is designed to be
   135 invoked via the =UI::run= method.
   136 CGI parameters, passed in $query:
   137 
   138 | =hidefile= | if defined, will not show file in attachment table |
   139 | =filepath= | |
   140 | =filename= | |
   141 | =filecomment= | comment to associate with file in attachment table |
   142 | =createlink= | if defined, will create a link to file at end of topic |
   143 | =changeproperties= | |
   144 | =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=. |
   145 
   146 Does the work of uploading a file to a topic. Designed to be useable for
   147 a crude RPC (it will redirect to the 'view' script unless the
   148 'noredirect' parameter is specified, in which case it will print a message to
   149 STDOUT, starting with 'OK' on success and 'ERROR' on failure.
   150 
   151 =cut
   152 
   153 sub upload {
   154     my $session = shift;
   155 
   156     my $query = $session->{cgiQuery};
   157     my $webName = $session->{webName};
   158     my $topic = $session->{topicName};
   159     my $user = $session->{user};
   160 
   161     my $hideFile = $query->param( 'hidefile' ) || '';
   162     my $fileComment = $query->param( 'filecomment' ) || '';
   163     my $createLink = $query->param( 'createlink' ) || '';
   164     my $doPropsOnly = $query->param( 'changeproperties' );
   165     my $filePath = $query->param( 'filepath' ) || '';
   166     my $fileName = $query->param( 'filename' ) || '';
   167     if ( $filePath && ! $fileName ) {
   168         $filePath =~ m|([^/\\]*$)|;
   169         $fileName = $1;
   170     }
   171 
   172     $fileComment =~ s/\s+/ /go;
   173     $fileComment =~ s/^\s*//o;
   174     $fileComment =~ s/\s*$//o;
   175     $fileName =~ s/\s*$//o;
   176     $filePath =~ s/\s*$//o;
   177 
   178     TWiki::UI::checkWebExists( $session, $webName, $topic, 'attach files to' );
   179     TWiki::UI::checkTopicExists( $session, $webName, $topic, 'attach files to' );
   180     TWiki::UI::checkMirror( $session, $webName, $topic );
   181     TWiki::UI::checkAccess( $session, $webName, $topic,
   182                             'CHANGE', $user );
   183 
   184     my $origName = $fileName;
   185     my $stream;
   186     my ( $fileSize, $fileDate, $tmpFilePath ) = '';
   187 
   188     unless( $doPropsOnly ) {
   189         my $fh = $query->param( 'filepath' );
   190         # $fh is both a file name *and* a file handle (see the CGI doc)
   191 
   192         try {
   193             # SMELL: use of undocumented CGI::tmpFileName
   194             $tmpFilePath = $query->tmpFileName( $fh );
   195         } catch Error::Simple with {
   196             # Item5130, Item5133 - Illegal file name, bad path,
   197             # something like that
   198             throw TWiki::OopsException(
   199                 'attention',
   200                 def => 'zero_size_upload',
   201                 web => $webName,
   202                 topic => $topic,
   203                 params => [ ($filePath || '""') ] );
   204         };
   205 
   206         $stream = $query->upload( 'filepath' );
   207         ( $fileName, $origName ) =
   208           TWiki::Sandbox::sanitizeAttachmentName( $fileName );
   209 
   210         # check if upload has non zero size
   211         if( $stream ) {
   212             my @stats = stat $stream;
   213             $fileSize = $stats[7];
   214             $fileDate = $stats[9];
   215         }
   216         unless( $fileSize && $fileName ) {
   217             throw TWiki::OopsException(
   218                 'attention',
   219                 def => 'zero_size_upload',
   220                 web => $webName,
   221                 topic => $topic,
   222                 params => [ ($filePath || '""') ] );
   223         }
   224 
   225         my $maxSize = $session->{prefs}->getPreferencesValue(
   226             'ATTACHFILESIZELIMIT' );
   227         $maxSize = 0 unless ( $maxSize =~ /([0-9]+)/o );
   228 
   229         if( $maxSize && $fileSize > $maxSize * 1024 ) {
   230             throw TWiki::OopsException(
   231                 'attention',
   232                 def => 'oversized_upload',
   233                 web => $webName,
   234                 topic => $topic,
   235                 params => [ $fileName, $maxSize ] );
   236         }
   237     }
   238     try {
   239         $session->{store}->saveAttachment(
   240             $webName, $topic, $fileName, $user,
   241             {
   242                 dontlog => !$TWiki::cfg{Log}{upload},
   243                 comment => $fileComment,
   244                 hide => $hideFile,
   245                 createlink => $createLink,
   246                 stream => $stream,
   247                 filepath => $filePath,
   248                 filesize => $fileSize,
   249                 filedate => $fileDate,
   250                 tmpFilename => $tmpFilePath,
   251             } );
   252     } catch Error::Simple with {
   253         throw TWiki::OopsException( 'attention',
   254                                     def => 'save_error',
   255                                     web => $webName,
   256                                     topic => $topic,
   257                                     params => [ shift->{-text} ] );
   258     };
   259     close( $stream ) if $stream;
   260 
   261     if( $fileName eq $origName ) {
   262         $session->redirect(
   263             $session->getScriptUrl( 1, 'view', $webName, $topic ), undef, 1 );
   264     } else {
   265         throw TWiki::OopsException( 'attention',
   266                                     def => 'upload_name_changed',
   267                                     web => $webName,
   268                                     topic => $topic,
   269                                     params => [ $origName, $fileName ] );
   270     }
   271 
   272     # generate a message useful for those calling this script from the command line
   273     my $message = ( $doPropsOnly ) ?
   274       'properties changed' : "$fileName uploaded";
   275 
   276     print 'OK ',$message,"\n";
   277 }
   278 
   279 1;