スポンサーサイト
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。
セッション管理をやってみた
>>http://www.dab.hi-ho.ne.jp/sasa/biboroku/perl/session.html
を 参考にさせていただいてセッション管理をやってみました。

今回ちょっとだけ改良させていただいたソースを載せます。
次は、>>「なんも考えないでパスワード認証 CGI」との合わせ技をやろうと考え中。

ファイル名:session_start.cgi
#!/usr/bin/perl -w

#main--------------------------------
use strict;
use CGI;
use CGI::Session qw/-ip_match/;

my $session=CGI::Session->new(undef,undef,{Directory=>'./.session'});
$session->expire('+1h'); #有効期限は1時間

my $sid = $session->id;
$session->param('hidden','YOU DO NOT KNOW BUT ....'); #セッション経由で引き渡す項目と値

print_html($sid);
#-----------------------------------

#サブルーチン-----------------------
sub print_html{
my $sid = shift;
my $cgi=CGI->new;
print $cgi->header(-charset=>'UTF-8',
-cookie=>$cgi->cookie(-name=>'CGISESSID',
-value=>$sid)),
#headerによりcookieにセッションidを保管
$cgi->start_html(-lang=>'ja',
-encoding=>'UTF-8',
-title=>'セッション管理を始めよう(Cookieを使用してます)');
print <<HTML_VIEW;
<h1>セッション管理を始めましょう(Cookieを使用してます)</h1>
<p>あなたのセッションIDは$sidです</p>
<form action="./session_end.cgi" method="post">
<input type="submit" value=" 認証する ">
</form>
HTML_VIEW
print $cgi->end_html;
}
#-----------------------------------



ファイル名:session_end.cgi
#!/usr/bin/perl -w

#main-----------------------------------------------------------------
use strict;
use CGI;
use CGI::Session qw/-ip_match/;

my $cgi=CGI->new;

my $sid=$cgi->cookie('CGISESSID')||$cgi->param('CGISESSID')||undef;
#1.cookieからCGISESSIDを探す
#2.cookieから取れなかったらurlパラメータを探す.
#3.どちらも取得できなかったらundef.
my $session=CGI::Session->new(undef,$sid,{Directory=>'./.session'});
#4.取得したセッションidが有効ならそのまま.無効なら別のidを発番.

my $hidden_message = '';
if(defined $sid && $sid eq $session->id){
#cookieかurlパラメータから値を取得でき,かつ有効なid
$hidden_message = $session->param('hidden');
print_html('セッション有効!(^^)v', $cgi, $sid, $hidden_message);
}
elsif(defined $sid && $sid ne $session->id){
#cookie,またはurlパラメータから値を取得できた.しかしidとしては無効
print_html('セッションは無効じゃぞ', $cgi, $sid, $hidden_message);
#不要なidはさっさと消去
#先にcloseをしないと,deleteで
#'(in cleanup) could not flush: Couldn't unlink .session/cgisess_CGISESSID'
#が発生する.エラーが出てもファイルは消える.
#closeは遅いらしい
$session->close;
$session->delete;
}
else{
#cookie,またはurlパラメータから値を取得できない.
print_html('セッションは無効(;_;)', $cgi, $sid, $hidden_message);
}

#サブルーチン--------------------------------------------
sub print_html{
my ($message, $cgi, $sid, $hidden_message) = @_;
print $cgi->header(-charset=>'UTF-8'),
$cgi->start_html(-lang=>'ja',
-encoding=>'UTF-8',
-title=>'セッション管理受取側');

print<<"HTML_VIEW";
<p>$message</p>
<p>セッションIDは「$sid」でした</p>
<p>実は裏では「$hidden_message」というメッセージがやりとりされています</p>
HTML_VIEW
print $cgi->end_html;
}
#--------------------------------------------------------

スポンサーサイト
ブリーフケース アップローダも実装
ファイルのアップローダもできたんで、ソースだけ載せちゃいます。
いやー 苦労した。


注意)以下のソースを参考にしてセキュリティホールになったとしても責任はとれませんのでご了承ください。

ファイル名:check_list2.cgi
#!/usr/bin/perl -w
use strict;
use CGI;

my $cgi = new CGI;
my $dir = $cgi->param('dir');
if($dir eq ""){ $dir = "/home/naka/public_html/"; }

print $cgi->header(-charset=>'euc-jp');
print $cgi->start_html(-lang=>'ja', -encoding=>'euc-jp', -title=>'check_list2.cgi');

my @lists;
if( -d $dir ){
chdir "$dir";
@lists = `ls $dir`;
foreach(@lists){
chomp $_;
}
print <<"HTML_VIEW";
<form action="./up_loader.cgi" method="post" enctype="multipart/form-data">
<p><input type="file" name="filename" /></p>
<input type="hidden" name="dir" value="$dir" />

<p>
<input type="submit" value="送信" />
<input type="reset" value="リセット" />
</p>
</form>
<p>今は$dirにいます</p>
HTML_VIEW
}

foreach my $list(@lists){
if( -d $list ){
my $next_query = $dir . $list . "/";
print "<a href=\"./check_list2.cgi?dir=$next_query\">";
print "<img alt=\"dir.gif\" border=\"0\" src=\"./dir.gif\" />";
print "$list";
print "</a><br />\n";
}elsif( -f $list ){
$dir =~ m|(/home/naka/public_html/)(.*)|;
my $next_query = "/~naka/" . $2 . $list;
print "<a href=\"$next_query\">";
print "<img alt=\"file.gif\" border=\"0\" src=\"./file.gif\" />";
print "ファイル $list";
print "</a><br />\n";
}
}

print $cgi->end_html;
#end



ファイル名:up_loader.cgi
#!/usr/bin/perl -w

# モジュール読み込み
use strict;
use CGI;

# POSTサイズの上限
$CGI::POST_MAX = 1024 * 1024 * 50; # 50MB

my $query = new CGI;
my $dir = $query->param('dir');
if($dir eq ""){ $dir = "/home/naka/public_html/"; }

# 送られてきたデータを処理する -----------------
# ファイル取得
my $FH = $query->upload('filename');

# エラーチェック
if ($query->cgi_error) {
my $err = $query->cgi_error;
error("$err") if ($err);
}

error("File transfer error.") unless (defined($FH));

# MIMEタイプ取得
my $mimetype = $query->uploadInfo($FH)->{'Content-Type'};

$FH =~ m/([\d\w\.]*?)$/;
my $file = $1;

# ファイル保存 ---------------------------------
my ($buffer);
my $full_path = $dir . $file;
open (OUT, ">$full_path") || error("uooooo can't open $full_path");
binmode (OUT);
while(read($FH, $buffer, 1024)){
print OUT $buffer;
}
close (OUT);
close ($FH) if ($CGI::OS ne 'UNIX'); # Windowsプラットフォーム用
chmod (0666, "$full_path");


# HTML出力 -------------------------------------
print $query->header(-charset=>'euc-jp'),
$query->start_html(-lang=>'ja', -encoding=>'euc-jp', -title=>'up_loader.cgi');

print <<"HTML_VIEW";
<h1>ファイルアップロード</h1>
<p>ファイルのアップロードが完了しました。</p>
<ul>
<li>フルパス : $full_path</li>
<li>ファイル名: $file</li>
<li>MIMEタイプ: $mimetype</li>
</ul>
<a href="./check_list2.cgi">トップへ戻る</a>
HTML_VIEW

print $query->end_html;
exit;

# エラー出力 -----------------------------------
sub error {
my $mes = shift;

print $query->header(-charset=>'euc-jp'),
$query->start_html(-lang=>'ja', -encoding=>'euc-jp', -title=>'up_loder.cgi');

print <<"HTML_VIEW";
<h1>ERROR</h1>
<p>$mes</p>
HTML_VIEW

print $query->end_html;
exit;
}
__END__



あ、ディレクトリ(フォルダ)を新しく作れないことに気づいた。現状だと、ファイルのアップロードしかできない。

アップロードの参考資料はもちろん
http://www.ss.iij4u.or.jp/~somali/web/_perl_upload.htmlを参考とさせていただきました。
ブリーフケース ダウンロードのみ実装
「Yahoo!ブリーフケース」というYahoo!のサービスがあります。
これは、ファイルを自分のパソコンではなくて、ネットの向こうに保存しておけるという便利なものです。

これをちょっと機能は劣りますが真似してみました。まだ完成形ではないので、URLは公開しません。

Yahoo!ブリーフケースはもちろんファイルの保存をできるわけなんですが、僕が今回作ったのはダウンロードのみ行えるようになっています。

ソースは以下の通りです。
まあ、これは ろんごんサーバが商用ではないので、ある程度ゆるめの設定にしてくれているから可能になったように思います。

注意)以下のソースを参考にしてセキュリティホールになったとしても責任はとれませんのでご了承ください。

ファイル名:check_list.cgi
#!/usr/bin/perl -w
use strict;
use CGI;

my $cgi = new CGI;
my $dir = $cgi->param('dir');
if($dir eq ""){ $dir = "/home/naka/public_html/"; }

print $cgi->header(-charset=>'euc-jp');
print $cgi->start_html(-lang=>'ja', -encoding=>'euc-jp', -title=>'check_list.cgi');

my @lists;
if( -d $dir ){
chdir "$dir";
@lists = `ls $dir`;
foreach(@lists){
chomp $_;
}
}

foreach my $list(@lists){
if( -d $list ){
my $next_query = $dir . $list . "/";
print "<a href=\"./check_list.cgi?dir=$next_query\">";
print "<img alt=\"dir.gif\" border=\"0\" src=\"./dir.gif\" />";
print "$list";
print "</a><br />\n";
}elsif( -f $list ){
$dir =~ m|(/home/naka/public_html/)(.*)|;
my $next_query = "/~naka/" . $2 . $list;
print "<a href=\"$next_query\">";
print "<img alt=\"file.gif\" border=\"0\" src=\"./file.gif\" />";
print "ファイル $list";
print "</a><br />\n";
}
}

print $cgi->end_html;
#end



説明:
my $dir = $cgi->param('dir');
if($dir eq ""){ $dir = "/home/naka/public_html/"; }

クエリーを処理しています。クエリーは1つしか受け取っていません。クエリーにはLinux環境下でのフルパスが入るように設計しました。

ApacheとLinuxではディレクトリの見え方が違っています(Document Rootの兼ね合い)ので、初期位置として /home/naka/public_html/ を教えています。 なお、始めてこのCGIを起動した場合はクエリーは空です。

my @lists;
if( -d $dir ){
chdir "$dir";
@lists = `ls $dir`;
foreach(@lists){
chomp $_;
}
}

念のためクエリーがディレクトリであるか調べています。ディレクトリなら、Linux環境的にカレントディレクトリを移動します(chdir "$dir";)。

@lists = `ls $dir`; によって、カレントディレクトリ下のディレクトリ名およびファイル名を@listsに代入します。 改行コードがはいってたので、chompもしました。


最後に、foreach my $list(@lists){ }の中についてです。
if( -d $list ){
my $next_query = $dir . $list . "/";
print "<a href=\"./check_list.cgi?dir=$next_query\">";
print "<img alt=\"dir.gif\" border=\"0\" src=\"./dir.gif\" />";
print "$list";
print "</a><br />\n";
}

-d $list でディレクトリであるかチェックできます。よってこのif文はディレクトリに対しての処理です。ディレクトリならもう一度 ls したいですよね。 ですからクエリーに次のディレクトリにあたるフルパスを与えてこのCGI(check_list.cgi)を呼び出しています。 $next_query が次のクエリーになります。

elsif( -f $list ){
$dir =~ m|(/home/naka/public_html/)(.*)|;
my $next_query = "/~naka/" . $2 . $list;
print "<a href=\"$next_query\">";
print "<img alt=\"file.gif\" border=\"0\" src=\"./file.gif\" />";
print "ファイル $list";
print "</a><br />\n";
}

-f $list はファイルであるか確認できます。ですから、これらの行はファイルだった場合に行われる処理です。 ファイルであるならもうCGIを呼び出す必要はありません。ただ、リンクを素直に飛べばよいだけです。しかし、少し注意がいります。このスクリプトではLinux環境下でのパスを扱ってきましたので、Apacheから見たパスに変換しています。
なんも考えないでパスワード認証 CGI
いま、ユーザ名とパスワードを入力してもらいログイン後はそのユーザが閲覧できるページのみ閲覧してもらうというシステムを考え中です。

パスワード認証して1ページ分だけ遷移できるものを作りました。

ココ↓です
http://ideon.dyndns.org/~naka/from_blog_cgi/AUTH_TEST/no_idea_check_password.html
ココ↑です


ログイン後にもっといろんなページを移動(遷移)したいならセッション管理の必要性があると思います。


ファイル名:no_idea_check_password.html
<?xml version="1.0" encoding="euc-jp"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja">
<head>
<title>認証ページ</title>
</head>
<body>
<h1>認証します</h1>

<form action="./no_idea_check_password.cgi" method="post">
ユーザ名   :<input type="text" name="user_name" size="20"> ← bingo<br /><br />
PASSWORD:<input type="password" name="password" size="20"> ← nakanishi<br />
<input type="submit" value=" 認証する ">
</form>

</body>
</html>



ファイル名:no_idea_check_password.cgi
#!/usr/bin/perl -w

use strict;
use CGI;

my %authentication = ("bingo" => "nakanishi");

# オブジェクト作成
my $query = new CGI;

# パラメータ取得
my $user_name = $query->param('user_name');
my $password = $query->param('password');

print $query->header(-type=>'text/html', -charset=>'euc-jp'),
$query->start_html(-lang=>'ja', -encoding=>'euc-jp', -title=>'no_idea_check_password.cgi');

if($password eq ""){ print "パスワードがはいってません"; print $query->end_html; exit; }
if($password eq $authentication{"$user_name"}){
print <<"HTML_VIEW";
<h1>認証成功(^^)v</h1>
<ul>
<li>ユーザ名:$user_name</li>
<li>PASSWORD:$password</li>
</ul>
HTML_VIEW
}else{
print <<"HTML_VIEW";
<h1>認証失敗(><)</h1>
あなたは、いったい誰ですか?
HTML_VIEW
}

print $query->end_html;
exit;



ユーザとパスワードをどのように引いているかなんですが、
my %authentication = ("bingo" => "nakanishi");

とハッシュによりスクリプトの中に直に埋め込んでいます。
あ、できた Web版 source2html
ソースをHTML形式に変換する perl2html.pl(source2html) を作ってきました。

今まで、

1)コマンドプロンプトから変換させたいファイルを引数として与える
2)Perl/Tkを用いてGUIで変換させたいファイルを選ぶ

の2種類作ってきましたが、これをWebでできるようにしてみました。

ココ↓です
>>http://ideon.dyndns.org/~naka/from_blog_cgi/2HTML/web_substitution.html
ココ↑です

参照から、変換させたいファイルを選んでもらえれば pre タグで囲まれたソースが表示されます。

以下、ソースです。

ファイル名:web_substitution.html
<?xml version="1.0" encoding="euc-jp"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja">
<head>
<title>アップロード用フォーム</title>
</head>
<body>
<h1>アップロード用フォーム</h1>

<form action="web_substitution.cgi" method="post" enctype="multipart/form-data">
<p><input type="file" name="filename" /></p>
<p>
<input type="submit" value="送信" />
<input type="reset" value="リセット" />
</p>
</form>

</body>
</html>


ファイル名:web_substitution.cgi
#!/usr/bin/perl -w

# モジュール読み込み
use strict;
use Jcode;
use CGI;

$CGI::POST_MAX = 1024 * 1024 * 50; # 50MB

# オブジェクト作成
my $query = new CGI;

# ファイル取得
my $FH = $query->upload('filename');


# MIMEタイプ取得
my $mimetype = $query->uploadInfo($FH)->{'Content-Type'};

binmode $FH;
my @lines = <$FH>;
foreach my $line (@lines){
$line = Jcode->new($line)->euc;
}

# HTML出力
print $query->header(-type=>'text/html', -charset=>'euc-jp'),
$query->start_html(-lang=>'ja', -encoding=>'euc-jp', -title=>'web_substitution.cgi');

print <<"HTML_VIEW";
<h1>ファイルアップロード</h1>
<ul>
<li>ファイル名:$FH</li>
<li>MIMEタイプ:$mimetype</li>
</ul>
HTML_VIEW

print "<pre>";
print "&lt;pre&gt;";
foreach my $line (@lines){
$line =~ s/&/&amp;amp;/g; # アンパサンド
$line =~ s/"/&amp;quot;/g; # 括弧のエスケープ
#$line =~ s/ /&amp;nbsp;/g; # 空白(使わず)
$line =~ s/\t/ /g;
#$line =~ s/\,/&amp;#044;/g;  # カンマのエスケープ(使わず)
$line =~ s/</&amp;lt;/g; # タグの排除
$line =~ s/>/&amp;gt;/g; # タグの排除

print "$line";
}
print "&lt;/pre&gt;";
print "</pre>";

print $query->end_html;
exit;




参考資料:
http://www.ss.iij4u.or.jp/~somali/web/_perl_upload.html
http://www.melma.com/backnumber_14785_1152969/


追記:
文字コードで結構苦しんで、Jcodeに落ち着いたんですが、UTF-8のBOMつきファイルを受け取った場合は、BOMの部分が?になっちゃうみたいですねぇ。。。
ブログ検索

プロフィール

ビンゴ中西
Perlが好きである。
プログラミング言語のほとんどは独学。独学の過程で多くのプログラム仲間にも色々教わりました。

FC2カウンター

カレンダー

09 | 2017/10 | 11
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31 - - - -

ブロとも申請フォーム

この人とブロともになる

| ホーム | 次のページ
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。