CGI.pmのuploadメソッドでファイル名取得したらフルパスからファイル名を取り出す処理を入れる

Tweet

個人的な覚え書き。

ファイル送信フォームを使用するクライアントが IE だったら、送られてきたファイル名をそのまま使うとキケンだよ。送信元のシステムにおけるフルパスが送信されます。

必ず、File::Basename モジュールの fileparse を通すか、正規表現等でファイル名だけを取り出す処理を追加しましょう。

#!C:/Program Files/Xampp/perl/bin/perl.exe
 
use strict; 
use warnings; 
use CGI; 
use File::Basename;
 
my $q = CGI->new; 
 
my $upload_FH = $q->upload('file');
fileparse_set_fstype('MSDOS');
my $filename  = fileparse($upload_FH);
 
print $q->header(
  -type    => 'text/plain',
  -charset => 'utf-8',
);
print q/$q->upload('file') :/,
  "\n\t$upload_FH\n\n";
print q/fileparse($q->upload('file')) :/,
  "\n\t$filename\n";

Win IE 6 からこの CGI に送信すると、以下のようになります。

$q->upload('file') :
	C:\Documents and Settings\CL\デスクトップ\test.lzh
 
fileparse($q->upload('file')) :
	test.lzh

（2007-11.15 16.47追記）

fileparse_set_fstype('MSDOS'); を挿入すべきでした。ソースには追加しておきました。作例はWindowsのActivePerlで動いているのでたまたま問題ないんですけれども、実行環境に依存するのです。

もっと正確にするには、IEのときだけ実行するコードにしましょう。

#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use File::Basename;
my $q = CGI->new();
if ( _checkWinIE() ) {
  fileparse_set_fstype('MSDOS');
}
my $file = q();
if ($q->upload('file') ) {
  $file = fileparse($q->upload('file') );
}
print $q->header( -type => 'text/plain' );
print "$file \n";
 
exit;
 
sub _checkWinIE {
  use HTTP::BrowserDetect;
  my $ua = HTTP::BrowserDetect
    ->new($ENV{'HTTP_USER_AGENT'});
  if ( ( $ua->browser_string() eq 'MSIE')
       && ( $ua->os_string() =~ m/^Win/ ) ) {
    return 1;
  }
  return;
}

2006.07.31 20:43 投稿　大野 義貴 [Perl] | 固定リンク |