Home / Menu

CGI-Perlの基礎講座

CGI-Perlの基礎講座(p05)

(本ページは、KENT WEBのFantasyボードプログラムをステップ単位に説明しています。)

◆ クッキーの発行&取得処理(947から990行目)

・概要

ついに、クッキーの処理にきました。ここも重要なので説明内容を濃くします!
クッキーは子供が食べるみたいに、クライアントのPCへ小さなデータを食べ(出力)させます。
具体的には、ゲストにURLやメールアドレスなど毎回入力させるのは気が引けるわけです。
そこで、PCのcookies.txtファイル等へ初回時、URLやメールアドレス等を書き込み、
次回からは、そこからデータを持ってきて、あたかももう入力済みの状態にします。

・947から990行目

クッキーの基本的な情報は以下の形式になっています。

名前=値;expires=有効日

名前=値は、
好きな名前に好きな値を指定します。セミコロン(;)、カンマ(,)、空白文字( )や日本語を使用する際にはそれぞれ、%3B、%2C、%20のようにエンコードして記述しなくてはなりません。複数の値を設定するには、複数のSet-Cookie:を用いるか、複数の名前と組を一つの値としてエンコードし、後で自力でデコードしてやらなくてはなりません。

expires=有効日は
クライアント側のディスクに記録されるCookieの有効期限を指定します。
フォーマットは以下の形式で指定します。

Tue, 25-Jan-2000 15:10:10 GMT

また、クッキーのファイル自体は
C:\Program Files\Netscape\Navigator\cookies.txt
C:\Program Files\Netscape\Users\UserName\cookies.txt
C:\Windows\Cookies\〜.txt
等にあります、エディッターやメモ帳などで見るだけならいいですが、編集してはいけません。

ではロジックを見ていきましょう。

## --- クッキーの発行
sub set_cookie {
    ($secg,$ming,$hourg,$mdayg,$mong,$yearg,$wdayg)
                = gmtime(time + 60*24*60*60);

    @mons = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
    $date_g = sprintf("%s, %02d\-%s\-%04d %02d:%02d:%02d GMT",
        $week[$wdayg],$mdayg,$mons[$mong],$yearg+1900,$hourg,$ming,$secg);

    $cook="name\:$name\,email\:$email\,url\:$url\,pwd\:$pwd\,area\:$area\,icon\:$icon";
    print "Set-Cookie: FANTA=$cook; expires=$date_g\n";
}

time関数で現時刻を取得して、60日分の秒をこれに加算して、gmtime関数でグリニッジ時間へ変換し、各スカラー変数へ格納します。
グリニッジ時間へ変換はクッキー仕様によるものです。
また、60日分の秒の加算は有効期限が60日ということです。
あとつぎの3行は、名前=値;expires=有効日を編集しています。もうわかりますね。
そして、標準出力で "Set-Cookie: FANTA=$cook; expires=$date_g\n" を出力するとクッキーがPC側へ設定されます。
本当は、$nameなどは、漢字が入りますのでエンコードしないといけませんが、とりあえず支障はないみたいです ^^;

## --- クッキーを取得
sub get_cookie {
    $cookies = $ENV{'HTTP_COOKIE'};
    @pairs = split(/;/, $cookies);

環境変数 HTTP_COOKIE から有効期限OKの該当データすべてが $cookiesへ格納されます。
クッキーのセットしたデータは名前毎に ; で区切られていますのでsplitで分割して、@pairsへ格納します。
つまりこの時点では @pairsは有効期限OKの該当のすべてのクッキーデータが格納されます。

    foreach $pair (@pairs) {
        local($name, $value) = split(/=/, $pair);
        $name =~ s/ //g;
        $DUMMY{$name} = $value;
    }

該当のすべてのクッキーデータが格納された @pairs から クッキー名毎に$DUMMYへクッキーデータを格納します。

        @pairs = split(/,/, $DUMMY{'FANTA'});
    foreach $pair (@pairs) {
        local($name, $value) = split(/:/, $pair);
        $COOKIE{$name} = $value;
    }

$DUMMYの'FANTA'の文字列を , 区切りの split でゲストブックでクッキー使用しているフォーム部品名と値をローカル(local)スカラー変数へ各々格納します。
そして、ハッシュ変数 %COOKIEへ格納します。あとは以下の通り、各スカラー変数($c_name、$c_email等)格納します。 if文以降がイマイチ理解できません。
ロジック的にはフォームのクッキー指定がONの時にフォームで設定されるべき各スカラー変数($name、$email等)が何か入っていればせっかくクッキーから持ってきた値を上書きしています。
が、この時点ではフォームのクッキー指定がONになる可能性はないので、不要なロジックだと推察します。
(フォームの入力処理前なので、$FORM{'cook'}の値はundefのはず)

    $c_name  = $COOKIE{'name'};
    $c_email = $COOKIE{'email'};
    $c_url   = $COOKIE{'url'};
    $c_pwd   = $COOKIE{'pwd'};
    $c_area  = $COOKIE{'area'};
    $c_icon  = $COOKIE{'icon'};

    if ($FORM{'cook'} eq 'on') {
        if ($name)  { $c_name  = $name; }
        if ($email) { $c_email = $email; }
        if ($url)   { $c_url   = $url; }
        if ($pwd)   { $c_pwd   = $pwd; }
        if ($area)  { $c_area  = $area; }
        if ($icon)  { $c_icon  = $icon; }
    }
}

補足(該当のすべてのクッキーデータとは)

クッキーには、expires=値(有効期限)の他に、path=値(パス)、domain=値(ドメイン)、secure(セキュア)があり、今回は、expiresのみの設定なので、path、domain、secureはデフォルトの設定になります。

pathのデフォルトの設定

クッキー値は、クッキーを生成したWebページ、同じディレクトリ内のWebページ、同じディレクトリ内のサブディレクトリ内のWebページで参照が可能です。

尚、パスの値を設定(path=値)すれば、それが、上記のようになります。

domainのデフォルトの設定

クッキー値は、クッキーを生成したWebページのホストのみ参照が可能です。

尚、ドメインの値を設定(domain=値)すれば、複数のサーバから参照ができます。ただし、自分のサーバーのドメイン以外は設定できません。

secureのデフォルトの設定

secureを記述しなければ、クッキーの安全性が保証されず(普通の場合です)、secureを記述すれば、httpsにてクッキー値が参照可能になるみたいです。

ホスト名取得処理(991から1003行目)

・概要

環境変数からホスト名とIPアドレスを取得します。

・991から1003行目

## --- ホスト名取得
sub get_host {
    $host = $ENV{'REMOTE_HOST'};
    $addr = $ENV{'REMOTE_ADDR'};

    if ($gethostbyaddr) {
        if ($host eq "" || $host eq "$addr") {
            $host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2);
        }
    }
    if ($host eq "") { $host = $addr; }
}

環境変数からホスト名とIPアドレスを各々 $hostと$addrへ格納します。

通常、環境変数のREMOTE_ADDRは入っていますが、REMOTE_HOSTは入っていないケースか、又はIPアドレスが入るケースが多いです。(サーバーのセキュリティの関係かなぁ?)
そこで、gethostbyaddr関数でIPアドレスからホスト名を取得することになります。

gethostbyaddr関数

ホスト名文字列(スカラー変数)= gethostbyaddr(4バイト長にパックされたアドレス, アドレスタイプ 2 固定);

また、「4バイト長にパックされたアドレス」をもとめるために、IPアドレスは 172.17.50.140 のようになっていますので、まず、splitでIPアドレスを . デリミタにてリスト(配列)にして pack の第二引数に渡します。
これを packは "C4"(char型4個) つまり「4バイト長にパックされたアドレス」にします。

削除キーの暗号化と照合処理(1004から1019行目)

・概要

削除キーの暗号化と削除キーの照合処理です。

・1004から1019行目


## --- 削除キーを暗号化
sub make_pwd {
    $times = time;
    $salt = substr($times,-2,2);
    return crypt($_[0],$salt);
}

現時刻の秒の二桁を暗号キー(substr($times,-2,2);)にして、crypt関数で削除キーを暗号化してリターンします。

crypt関数

暗号化された文字列(スカラー変数)= crypt(暗号化する文字列, 二桁の暗号キー文字列);
尚、暗号化された文字列の頭2桁は暗号キーになります。

## --- 削除キーを照合
sub match_pwd {
    if ($_[1] =~ /^\$1\$/) { $key = 3; } else { $key = 0; }
    $match = "no";
    if (crypt($_[0], substr($_[1],$key,2)) eq "$_[1]") {
        $match = "yes";
    }
}

($_[1] =~ /^\$1\$/) はよくわかりませんが、暗号化された文字列の頭3桁が $1$ になるケースがあるみたいです。
そして、今回入力された削除キーを暗号化した文字列(crypt($_[0], substr($_[1],$key,2))と前回($_[1])のと比較して削除キーの照合をします。

ロックファイル処理(symlink関数&open関数)(1020から1043行目)

・概要

ロックファイル処理(symlink関数&open関数)です。
プロバイダのPerl実装を考慮して二種類の方式(symlink関数利用とopen関数利用)を用意しています。

・1020から1043行目

## --- ロックファイル(symlink関数)
sub lock1 {
    local($retry) = 5;
    while (!symlink(".", $lockfile)) {
        if (--$retry <= 0) { &error("LOCK is BUSY","lock"); }
        sleep(1);
    }
}

local関数でスカラー変数$retryをローカル変数にしています。これは、スカラー変数$retryがlock1サブルーチン内のみ有効にすることです。
つまり、他の関数で$retryの名前を使用しても影響がないって事です。

symlink関数(ファイルをシンボリックリンクします。)

成功時真、失敗時偽= symlink(元ファイル名, シンボリックリンク名);

ロックファイルをシンボリックリンクする時に、すでに存在している時は、失敗して偽を返します。
そこで、! で真理値を反転させて、5回まで1秒スリープして待ちます。それでもロックが解除されない時は、&errorでエラー処理になります。

## --- ロックファイル(open関数)
sub lock2 {
    local($flag) = 0;
    foreach (1 .. 5) {
        if (-e $lockfile) { sleep(1); }
        else {
            open(LOCK,">$lockfile") || &error("Write Error : $lockfile","lock");
            close(LOCK);
            $flag = 1;
            last;
        }
    }
    if ($flag == 0) { &error("LOCK is BUSY","lock"); }
}

ロックファイルが存在しない時は、オープン、クローズでロックファイルを作成して処理を続行します。
ロックファイルが存在する時は、5回まで1秒スリープして待ちます。それでもロックが解除されない時は、&errorでエラー処理になります。

メール送信&イメージ表示&一時ファイル定義処理(1044から最終行目)

・概要

メール送信処理は、データを7ビットJISにしてsendmailコマンドでメール送信します。
イメージ表示は、イメージgifの表示処理です。
一時ファイル定義処理は、データ更新等で使用するために一時的なファイルを作成します。

・1044から最終行目

## --- メール送信
sub mail_to {
    # メール送信用に他変数に置換
    $m_sub  = "$title に投稿がありました";
            :
            :
    # 文字コードをJIS変換
        &jcode'convert(*m_sub,'jis');
        &jcode'convert(*m_name,'jis');
        &jcode'convert(*m_com,'jis');

上記3行は文字列データの文字コードをJISへ変換しています。
まず、&jcode'convertでjcodeパッケージのconvetサブルーチンを示します。

*m_subや*m_nameのように単独の識別子の前に * を付けたものは型グロブといって、
例えば、*m_sub の場合、$m_sub, @m_sub, %m_sub, &m_sub, 単なるm_sub のいずれまたはすべてを表します。
用途は、サブルーチンなどで配列やハッシュ自体を指し示す「参照」を受け渡すことやファイルハンドル渡したり格納しておくことです。
あと、変数名に別名を付ける場合にも使用されます。
例えば、

*abc = *xyz;

のときは各々、$abc と $xyz、@abc と @xyz、%abc と %xyz、&abc と &xyz、 abcとxyz(ファイルハンドル)はそれぞれ同じものを表します。

    # sendmail起動
    if (open(MAIL,"| $sendmail $mailto")) {
    print MAIL "To: $mailto\n";

    # メールアドレスがない場合はダミーメールに置き換え
    if ($email eq "") { $email = 'nomail@xxx.xxx'; }

    print MAIL "From: $email\n";
    print MAIL "Subject: $m_sub\n";
    print MAIL "MIME-Version: 1.0\n";
    print MAIL "Content-type: text/plain; charset=ISO-2022-JP\n";
    print MAIL "Content-Transfer-Encoding: 7bit\n";
    print MAIL "X-Mailer: $ver\n\n";
    print MAIL "--------------------------------------------------------\n";
    print MAIL "TIME : $date\n";
    print MAIL "HOST : $host\n";
    print MAIL "NAME : $m_name\n";

    if ($FORM{'email'}) { print MAIL "EMAIL: $FORM{'email'}\n"; }
    if ($url) { print MAIL "URL  : http://$url\n"; }

    print MAIL "$m_com\n";
    print MAIL "--------------------------------------------------------\n";
    close(MAIL);
    }
} 

メール送信をしています。ここで、目新しいのは、perlでは、普通標準入力からデータをもらうコマンド(sendmail)の場合(今回はパールのロジックのメモリからデータをもらう)、open関数を利用してもらうことができることです。
具体的には open(MAIL,"| $sendmail $mailto") の | でできます。

ここで、sendmailについて補足説明致します。

メールヘッダ情報は「To:」と「From:」「Subject:」以外に「Cc:」(カーボンコピー)「Bcc:」(ブラインドカーボンコピー)があります。
これらは、ただ単に print MAIL "Cc: 〜; 等を追加しても有効になりません。
以下のように-tオプションを指定します。実は、「To:」もこれで有効になります。
つまり、現状の print MAIL "To: $mailto\n"; は意味がありませんが、$sendmail $mailto でメールアドレスを指定しているので上手く行ってます。

        $ENV{'TZ'} = "JST-9";
        ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
        # 日時のフォーマット
        @week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
        @mname = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
        $date = sprintf("%s, %d %s %04d %02d:%02d:%02d +0900 (JST)",
                      $week[$wday],$mday,$mname[$mon],$year+1900,$hour,$min,$sec);
 
        if (open(MAIL,"| $sendmail -t $mailto")) {
            print MAIL "Date: $date\n";
            print MAIL "To: $mailto\n";
            print MAIL "From: $email\n";
            print MAIL "Cc: aaa@bbb.ne.jp,xxx@yyy.ne.jp";
            print MAIL "Bcc: 〜〜";
            print MAIL "Subject: $m_sub\n";
                  :
                  :

「To:」「Cc:」「Bcc:」で各々複数のメールアドレスに送信するときは 「,」で続けます。
また、「Date:」は指定しないとメイラーが付加してくれますが、指定すればこちらが優先です。

尚、メールアドレスが存在しない所へ送信した場合のリプライは、メールサーバーの設定によりいろいろありますので、メールサーバー管理者に問い合わせる必要があります。
 普通はEnvelop fromへ戻ります。(Envelop fromとは、sendmailコマンドを使って送信した場合は、ログインアカウント名から生成。sendmailのdaemonとSMTPで通信した場合は、メーラの仕様に依存)
Envelop fromは -f オプションで変更可能ですが予め権限をもらっておく必要があります。

あと、「Subject:」で日本語を使用する時は、注意が必要です。普通はJIS漢字が通りますが、稀に文字化けします。
この場合は、日本語を一度JISコードに変換し、それを、BASE64という形式でエンコードし、前後に =?iso-2022-jp?B? と ?= をつけます。
これが本来の仕様みたいです。以下が参考になります。

http://tohoho.wakusei.ne.jp/twn/wwwxx006.htm

また、添付ファイルも送ることができます。
以下のようにMIMEコマンド(Content〜)を駆使し、添付ファイルデータはbase64でエンコーディングします。
(UNIXではuuencodeがよく使用される)

From: from <from@mail.address>
Subject: hoge
To: to@mail.address
Mime-Version: 1.0
Content-Type: Multipart/Mixed; boundary=simple
Content-length: (エンコードされた添付ファイルデータのサイズ)

--simple
Content-Type: text/plain; charset=iso-2022-jp
Content-Transfer-Encoding: 7bit
(1行空けるべし=空行)
これは〜のLZHファイルです。
(ここにも空行)
--simple
Content-Type: application/x-lzh; name="hoge.lzh"
Content-Transfer-Encoding: base64
(ここにも空行)
hoge.lzhをBASE64エンコーディングしたもの。
(ここにも空行)
--simple

以下が添付ファイル送信のsendmail使用のサンプルプログラムです。

#!/usr/local/bin/perl
#
require 'jcode.pl';
require 'mimew.pl';

$sendmail = '/usr/lib/sendmail';
$bound = 'wq5se3d1ew';
$ufile = 'hoge.lzh';
$ufilenm = 'hoge.lzh';
$mailto = 'aaa@bbb.ne.jp';
$ownermail = 'xxx@yyy.ne.jp';
$subject = 'TEST-TENPU';

open(IN,"$ufile");
$lzhdata = join('',<IN>);
close(IN);
$base64_lzhdata = &bodyencode($lzhdata);
$base64_lzhdata .= &benflush;

#-------BEGINBEGIN---------
$header =<<END;
FormMailer: FormMail
To: $mailto
From: $ownermail
Subject: $subject
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="$bound"
END
#-------ENDEND----------

#-------BEGINBEGIN---------
$body =<<END;
--$bound
Content-Type: text/plain; charset="iso-2022-jp"
Content-Transfer-Encoding: 7bit

hogehoge様

ありがとうございました。ファイルをお送りします。
LZH形式で圧縮されていますので、解凍してお使い下さい。

--$bound
Content-Type: application/x-lzh; name="$ufilenm"
Content-Transfer-Encoding: BASE64

$base64_lzhdata

--$bound--
END
#-------ENDEND----------

&jcode::convert(*header,'jis');
&jcode::convert(*body,'jis');
$header .= "Content-length: ".length($body)."\n";

#print "$header\n$body\n";

if (open(OUT,"| $sendmail -t")) {
print OUT "$header\n$body";
close(OUT);
}

mimew.plはmime_plsのページにあります。 (生田 昇様、こちらのミスで長い間不正な再配布をしていたことをお詫びいたします。また、これを指摘してくださったB-Cusさん、ありがとうございました。)

尚、このロジックはラウンジの B-Cus氏の発言スレッドを参考にさせて頂きました。(いつもすみません)

## --- イメージ表示
sub image {
    &header;
          :
          :
    $stop = @icon1;
    foreach (0 .. $#icon1) {
        $i++; $j++;
                :
                :
    }
        :
        :
    exit;
}

イメージ表示は、イメージgifの表示処理です。 目新しいのは $#icon1です。
これは、配列変数 @icon1 の最後のインデックスの値が格納されています。

## --- 一時ファイル定義
sub temp {
    # 一時ファイルを定義
    $temp = "$$";
    if ($temp eq '') {
        srand;
        $temp = 1000000000000000 * rand;
    }
    $tmpfile = "$lockdir\/$temp\.tmp";
}

srand と rand はペアで用い、srand関数は乱数の種を仕込み、rand関数で乱数を発生させています。
これに拡張子 .tmp を付けて一時ファイル名を作成しています。

Home / Menu