lib/TWiki/UI/Upload.pm
changeset 0 414e01d06fd5
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     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;