中年プログラマーの息抜き

カシマルです。 最近、新しい土地へ引っ越しをしたのですが、これを機に何か始めたいなと思ってブログをはじめました。気の向くままに更新していきます。

PERL[CGI]でPHPのSESSIONを利用してみます

はじめに

PERLで作ったダウンローダーって行数少なくソフト的にはファイルサイズに上限がないなど、個人的に便利なので社内のちょっとしたシステムでよく使います。

一方でメイン画面は他言語でPERLを使う機会は減っていて、ほかの言語で書いたプログラムとセッション情報を共有するには工夫が必要なこともあります。

今回は、メイン画面をPHPでログイン処理するようなシステムがあり、そのセッション情報をPERLから利用する機会があったのでそのメモです。

簡単に機能説明

PHP
ログイン情報をセッションで保持する
({ id }を含む連想配列をloginという名前で保持する)
PERLCGI
ログイン情報をPHPのセッションから取得する
(取得できればファイルをダウンロードさせる)
リクエストパラメータでファイルを特定する
(id=5 みたいなパラメータでMySQLを検索)

依存ライブラリ(CPAN

ライブラリ使ってみます。下の三つを配置してCGIスクリプトから参照。CPANの環境からだと「PHP::Session」を入れたら全部落ちてくるような気もします。

CGIDBIなど一般的なライブラリ
XSERVERなどレンサバで最初から使えるものは割愛します。
・UNIVERSAL::require
https://metacpan.org/pod/UNIVERSAL::require
PHP::Session
https://metacpan.org/pod/PHP::Session
PHP::Session::Serializer::PHP
https://metacpan.org/pod/PHP::Session::Serializer::PHP

CGIのサンプル

エラー処理は省略。(例えば、PHP::Session->new が失敗すると異常終了します)

#!/usr/bin/perl
use strict;
use warnings;
use lib 'modules';#依存ライブラリを配置したディレクトリ

use CGI qw(:standard);
use PHP::Session;
#セッションファイルの場所はphpinfo()等で確認して、
my $session = PHP::Session->new(cookie('PHPSESSID'), { save_path => '/***/php/session' });
if ($session && $session->get('login') && $session->get('login')->{'id'}) {
    use DBI;
    use Encode qw/encode_utf8/;
    use URI::Escape;

    my %form = ( "id" => "" );
    my $query = $ENV{'QUERY_STRING'};
    $query =~ tr/+/ /;
    $query =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
    foreach (split(/&/, $query)) {
        my ($k, $v) = split(/=/,$_);
        $v =~ tr/+/ /;
        $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $form{$k} = $v;
    }

    if ($form{"id"}) {
        my $dsn = "dbi:mysql:database=***;host=***;port=***";
        my $user = "***";
        my $pass ="***";
        my $dbh = DBI->connect($dsn, $user, $pass, {
            AutoCommit => 1,
            PrintError => 0,
            RaiseError => 1,
            ShowErrorStatement => 1,
            AutoInactiveDestroy => 1
        })|| die $DBI::errstr;
        my $sth = $dbh->prepare("SELECT name `ファイル名`,path `ファイルパス` FROM ***);

        $sth->execute();
        if (my @row = $sth->fetchrow) {
            my $name = URI::Escape::uri_escape($row[0]);
            open IN,"$row[1]" || die "E3001:400 Bad Request.";
            print "Content-type: application/octet-stream\n";
            print "Content-Disposition: attachment; filename=\"$row[0]\"; filename*=UTF-8''$name\n\n";
            print ;
            close IN;
        } else {
            die "E3002:400 Bad Request.";
        }
        $sth->finish;
        $dbh->disconnect;
    } else {
        die "E3003:400 Bad Request.";
    }
} else {
    die "E3004:401 Unauthorized.";
}



1;

まとめ

PERLは好きな言語です。

ab39