package gateway; use strict; #=============================================================================== # gateway.cgi: Perl-CGIスクリプトに簡易認証システムを組み込む # The latest version is here: http://confetto.s31.xrea.com/ # This script use a japanese character code set: Shift_JIS #=============================================================================== # Copyright (c) 2003-2007 confetto. # # Permission is hereby granted, free of charge, to any person obtaining a copy # of this software and associated documentation files (the "Software"), to deal # in the Software without restriction, including without limitation the rights # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell # copies of the Software, and to permit persons to whom the Software is # furnished to do so, subject to the following conditions: # # The above copyright notice and this permission notice shall be included in # all copies or substantial portions of the Software. # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE # SOFTWARE. #=============================================================================== my $rcsid=q$Id: gateway.cgi,v 1.4 2007/04/18 16:08:52 confetto Exp $; #=============================================================================== # 初期設定 #=============================================================================== #### アカウントの設定 # 下記の例にならって、ユーザ名とパスワードを対にしてコロン(:)で区切り、1行に1ア # カウントずつ並べてください。半角英数字のみ使えます。余計な空行や空白を含めない # でください。END_OF_USERNAMESという行はいじらないでください。 my $USERNAMES = <<'END_OF_USERNAMES'; test:test guest:guest END_OF_USERNAMES #### 外部のユーザ認証ファイルのパス # 使う場合は指定。ApacheのBASIC認証が使うユーザ認証ファイル(.htpasswd)と同じ形式 # のテキストファイルで、パスワードがcrypt()で暗号化されたものであれば、アカウン # ト情報として使うことができます。 my $PASSWD_FILE = ''; #### ホームページのURI # 認証フォームからの戻り先URIを指定してください。相対URIを指定する場合は、組み込 # み対象のCGIスクリプトからの相対で指定してください。 my $HOME_PAGE = '/'; #### 広告等挿入部 # 認証ページの最上部に広告等を挿入できます。''の代わりにHTMLコード # 等を挿入してください。複数行に渡っても構いません。 my $AD_BLOCK = <<'END_OF_AD_BLOCK'; END_OF_AD_BLOCK #### 外部スタイルシートのURI # 認証ページに適用するスタイルシート(CSS)のURIを指定してください。相対URIを指定 # する場合は、組み込む対象のCGIスクリプトからの相対で指定してください。 my $CSS_FILE = 'gateway.css'; #### スクリプトのURI # 組み込み対象のCGIスクリプトのURIです。通常は自動的に取得しますが、取得がうまく # いかないときなどは手動で指定します。 my $SCRIPT_URI = ''; #### クッキーのパス # 指定しなければ「対象のCGIスクリプトのあるディレクトリ」が既定値です。 my $COOKIE_PATH = ''; #### クッキーの有効期限(日数) # フォームにパスワードなどを記憶するためのクッキーの有効期限です。 my $COOKIE_EXPIRE = 30; # 30日 # クッキーの名前 my $FORM_COOKIE_NAME = 'gatewayform'; # フォーム用 my $TEMP_COOKIE_NAME = 'gatewaytemp'; # セッション用 # スクリプトの文字符号化方式 my $ENCODING = 'Shift_JIS'; #=============================================================================== # ルーチン #=============================================================================== my($VERSION) = $rcsid =~ /,v ([\d.]+)/; $SCRIPT_URI ||= script_uri('relative') || './'; if ($COOKIE_PATH eq '') { $COOKIE_PATH = script_uri(); $COOKIE_PATH =~ s|[^/]+$||; } &{ sub { # クッキーを取得して認証できれば抜ける return if authorize(split /:/, cookie($TEMP_COOKIE_NAME)); # パラメタを取得して認証 my $params = read_params(); # 認証できればクッキーを発行して抜ける if (authorize(@$params{'_username','_password'})) { set_cookies($params); return; } print_header(); if (defined $params->{_username}) { print_html_start(title => '認証に失敗しました'); print_auth_error(); } else { print_html_start( title => 'ユーザ名とパスワードを入力してください', onload => 'document.forms.auth._username.focus()' ); print_auth_form(); } print_html_end(); exit; } }; #=============================================================================== # サブルーチン #=============================================================================== # # 認証フォームを出力する # sub print_auth_form { my($username, $password) = split /:/, cookie($FORM_COOKIE_NAME); my $savecookie = ' checked="checked"' if $username; print <Cookieを無効にしているとログインできませんのでご注意ください。

END_OF_HTML } # # 認証エラーを出力する # sub print_auth_error { print <ユーザ名が存在しないか、パスワードが違います。

END_OF_HTML } # # エラーを出力して終了する # sub error { my($message) = @_; print_header(); print_html_start(title => 'エラー'); print qq'

$message

'; print_html_end(); exit; } # # HTTPレスポンスヘッダを出力する # sub print_header { print < '無題', @_); print qq''; print ''; print ''; print ''; print qq''; print qq''; print ''; print qq'$args{title}'; print ''; print $args{onload} ? qq'' : ''; print qq'$AD_BLOCK

$args{title}

'; } # # HTMLの最後の部分を出力する # sub print_html_end { print <gateway.cgi $VERSION END_OF_HTML } # # パラメタを読み込みハッシュ(のリファレンス)で返す # sub read_params { my($buffer, $name, $value, %params); read STDIN, $buffer, $ENV{CONTENT_LENGTH}; $ENV{CONTENT_LENGTH} = 0; foreach (split /&/, $buffer) { ($name, $value) = split /=/; $value =~ tr/+/ /; $value = unescape($value); $params{$name} = $value; } wantarray ? %params : \%params; } # # 認証を行う # ユーザ名とパスワードを引数に取り、認証に成功すれば1、さもなくば # undefを返す。 # sub authorize { my($username, $password) = @_; my %passwds = split /\n|:/, $USERNAMES; return if !$username or !$password; return 1 if $passwds{$username} eq $password; return if $PASSWD_FILE eq ''; open IN, $PASSWD_FILE or error("ユーザ認証ファイルを開けません: $!"); while () { chomp; my($username_, $password_) = split /:/; next if $username_ ne $username; next if $password_ ne crypt($password, $password_); return 1; } close IN; return undef; } # # クッキーを発行する # フォーム用とセッション用のクッキー2つを、Set-Cookieヘッダを出力して # 発行する。 # sub set_cookies { my($params) = @_; my $value = join ':', @$params{'_username','_password'}; my $expdays = $$params{_savecookie} ? $COOKIE_EXPIRE : -1; my $cookie1 = cookie($FORM_COOKIE_NAME, $value, $expdays); my $cookie2 = cookie($TEMP_COOKIE_NAME, $value, undef, $COOKIE_PATH); print "Set-Cookie: $_\n" foreach ($cookie1, $cookie2); } # # クッキーの取得および生成(汎用) # sub cookie { my($name, $value, $expdays, $path) = @_; if ($value) { my $cookie = "$name=" . escape($value); if ($expdays) { my $expires = expires(time + $expdays*24*60*60); $cookie .= "; expires=$expires"; } $cookie .= "; path=$path" if $path; return $cookie; } else { ($value) = $ENV{HTTP_COOKIE} =~ /$name=([^;]*)/; return unescape($value); } } # # クッキーの有効期限の文字列を生成する # sub expires { my($time) = @_; my @mons = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my @wdays = qw(Sun Mon Tue Wed Thu Fri Sat); my($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time); return sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT", $wdays[$wday],$mday,$mons[$mon],$year+1900,$hour,$min,$sec); } # # URIエスケープ・アンエスケープする # 出典: http://www.din.or.jp/~ohzaki/perl.htm#JP_Escape # sub escape { my $s = shift; $s =~ s/(\W)/'%' . unpack('H2', $1)/eg; return $s; } sub unescape { my $s = shift; $s =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg; return $s; } # # スクリプトのURIを取得する # 参考: CGI.pm version 3.04 # sub script_uri { my($format) = @_; my $uri = $ENV{SCRIPT_NAME}; if (exists $ENV{REQUEST_URI}) { $uri = unescape($ENV{REQUEST_URI}); $uri =~ s/\?.+$//; if (exists $ENV{PATH_INFO}) { my $path = unescape($ENV{PATH_INFO}); $uri =~ s/\Q$path\E$//i; } } $uri =~ s|([^\w.%;&?/\\:+=~-])|'%' . unpack('H2', $1)|eg; $uri =~ s|.*/|| if $format eq 'relative'; return $uri; } 1;