プログラムコード

Perl で CGI を利用して実用的なファイルアップロードを行うためのプログラムコードは次の通りです

#!/usr/bin/perl -T



use warnings;

use strict;



#// ----------------------------------------------------------

#// Perl CGI ファイルアップロード

#// ----------------------------------------------------------



use CGI;



# 本番環境では削除する

use CGI::Carp qw(fatalsToBrowser);



# 最大ファイルサイズ 100 KB

$CGI::POST_MAX = 1024 * 100; 



# プロトタイプ宣言

sub save_file($);



# CGI オブジェクト

my $q = new CGI;



# HTTP ヘッダ

print $q->header(-charset => 'euc-jp');



#// ----------------------------------------------------------

#// HTML

#// ----------------------------------------------------------



# HTML ヘッダ

print $q->start_html( -title => "アップローダー",

                      -lang => 'ja');



# フォーム スタート

print $q->h3('このフォームからファイルをアップロード出来ます'),

      $q->start_form( -name => 'main_form');



# ファイルフィールド

print $q->p('アップロードするファイルを選択してください: '),

      $q->filefield( -name => 'filename',

                     -size => 40,

                     -maxlength => 80);



# 投稿ボタン

print $q->hr;

print $q->submit(-value => 'アップロード');

print $q->hr;



# フォーム エンド

print $q->end_form;



# サイズ超過チェック

if (!$q->param('filename') && $q->cgi_error()) {



    # 超過していた場合の処理



    # HTTP ステータスコードを出力

    print $q->p($q->cgi_error());



   # エラーメッセージ

    print <<'EOT';

<p>!! ファイルサイズが許容値を超えています。

<p>許容値に関してはシステム管理者に確認してください。

EOT



    # アップロード可能なファイルサイズを出力

    print $q->p("最大 : $CGI::POST_MAX byte (", $CGI::POST_MAX / 1024, "KB)");

    print $q->hr, $q->end_html;

    exit 0;

}



# ファイルアップロード

if ($q->param()) {



    # 処理を担当するサブルーチン

    save_file($q);

}



# HTML エンド

print $q->end_html;



# プログラム終了

exit 0;



#// ----------------------------------------------------------

#// ファイルアップロード処理

#// ----------------------------------------------------------



sub save_file($) {



    # CGI オブジェクト取得

    my ($q) = @_;



    # For 関数 read()

    my ($bytesread, $buffer);



    # read() で 1 度に読込むデータサイズ

    my $num_bytes = 1024;



    # ファイルサイズを格納

    my $totalbytes;



    # ファイル名と同名のファイルハンドル

    my $filename = $q->upload('filename');



    # 汚染チェック後のファイル名を格納

    my $untainted_filename;



    # ファイル名が入力されていない場合

    if (!$filename) {

        print $q->p('ファイルを選択してください。');

        return;

    }



    # ファイル名の汚染チェック

    if ($filename =~ /^([-\@:\/\\\w.]+)$/) {



        # 除染したファイル名の文字列を取得

        $untainted_filename = $1;



    } else {



        # 汚染されていた場合は die

        die <<"EOT";

ファイル名にサポートしていない文字が含まれています。

ファイル名に利用可能な文字は "アルファベット" と "数字" 

および 次の記号です。

「 _ 」「 - 」「 \@ 」「 / 」「 \\ 」「 . 」

EOT

    }



    # 続・汚染チェック

    if ($untainted_filename =~ /\.\./) {



        # 汚染されていた場合は die

        die <<"EOT";

ファイル名に連続したピリオド「 .. 」が含まれています。

「 .. 」を除外したファイル名で再度アップロードしてください。

EOT

    }



    # ファイルの書き込み先を設定

    my $file = "UPFILE/$untainted_filename";



    print $q->p("$filename を $file にアップロードします。");



    # 書き込みモードのファイルハンドルをオープン

    open (OUTFILE, ">", "$file") or die "Couldn't open $file for writing: $!";



    # ループ : データの読み込みと書き込み

    while ($bytesread = read($filename, $buffer, $num_bytes)) {



        # ファイルサイズの累算

        $totalbytes += $bytesread;



        # 指定領域に書き込み

        print OUTFILE $buffer;

    }



    # エラーチェック : $bytesread が undef なら die

    die "データの読み込みが失敗しました。" unless defined($bytesread);



    # 続・エラーチェック : $totalbytes が undef なら

    unless (defined($totalbytes)) {



        print $q->p("エラー: ファイルを読み込めませんでした ${untainted_filename}, ");

        print $q->p("またはファイルの長さがゼロです。");



    } else {



        # エラーチェッククリア : 完了のメッセージ

        print $q->p("完了。ファイル $filename を $file にアップロードしました ($totalbytes bytes)");

    }



    # ファイルハンドルクローズ

    close OUTFILE or die "$file をクローズ出来ませんでした : $!";



# アップロード処理のサブルーチン終了

}

プログラムコードの処理

上記プログラムコードの各処理詳細は、次の記事で確認しました。

  1 行目 (0x10d) コマンドスイッチ「 -T 」

  13 行目 (0x10e) モジュール「 CGI::Carp 」

  16 行目 (0x10f) 変数「 $CGI::POST_MAX 」

  19 行目 (0x110) 関数「 プロトタイプ 」

  25 行目 (0x111) HTTP, HTML ヘッダの言語指定

  36 行目 (0x112) HTML「 フォーム作成 」

  54 行目 (0x113) サイズ超過チェック

  59 行目 (0x114) HTTP ステータスコード 概要

  59 行目 (0x115) HTTP ステータスコード 詳細

  59 行目 (0x116) サイズ超過エラーの処理

  77 行目(0x117) サブルーチンの呼び出し

  93 行目 (0x118) アップロード処理 変数宣言

 117 行目 (0x119) 入力・汚染チェック

 117 行目 (0x11a) 汚染チェック 正規表現

 134 行目 (0x11b) 続・汚染チェック

 152 行目 (0x11c) 読み込み・書き込み 概要

 152 行目 (0x11d) 読み込み・書き込み 詳細

0x11e -> 0x11f へ

次回は、Web ブラウザ上での表示と動作を確認します。


#// YAPC::Asia Tokyo 2015 開催日程決定 !

記念すべき 10 回目 YAPC::Asia Tokyo 2015 の開催が、8/20 - 8/22 に決定したそうです。そしてこれが「 最後の開催 」になるんだってさ。まーじか。

日本最大の Perl 祭り。僕はこのまま、ありのまま、参加することがないままで、気の向くままにたゆたって、今のままに過ごすのか ? 2015 年、夏。どうなるか見てみよう。


参考情報は書籍「 初めての Perl 第 6 版 」を中心に perldoc, Wikipedia および各 Web サイト。それと詳しい先輩。

目次 - Perl Index