でびぞー徒然日記

$pathinfo_maxlength ) { // Path Info Too Long. } else { // Maybe Ok. // $tmp_uri = substr($get_uri, strlen($paginate_page_selector) + 2 ); //print "tmp: $tmp_uri
"; if ($tmp_uri == "all") { // OK // $paginate_current_page = "all"; } else { $tmp_uri2 = $tmp_uri; $pattern = '/\d+/'; $replacement = ''; $tmp_uri3 = preg_replace($pattern, $replacement, $tmp_uri2); if ($tmp_uri3 == "") { //print "Checking3...
"; #---- Maybe Ok ---- if ( is_numeric($tmp_uri2) ) { $paginate_current_page = $tmp_uri2; } } } } } } $paginate_num_pages = 2; $paginate_num_sections = 11; //$paginate_current_page = @$_GET['page']; // Pin page selector to a valid number (or 'all') if($paginate_current_page=='') $paginate_current_page = '1'; if($paginate_current_page != 'all') { if($paginate_current_page == 'first') $paginate_current_page = 1; elseif($paginate_current_page == 'last') $paginate_current_page = 2; elseif($paginate_current_page < 1) $paginate_current_page = 1; elseif($paginate_current_page > 2) $paginate_current_page = 2; $paginate_sections = array( 0 , 10, 11); $paginate_top_section = $paginate_sections[$paginate_current_page-1]+1; $paginate_bottom_section = $paginate_sections[$paginate_current_page]; } else { $paginate_top_section = 1; $paginate_bottom_section = 11; } /* if(isset($_SERVER['QUERY_STRING'])) { $paginate_self = '&' . $_SERVER['QUERY_STRING'] . '&'; $paginate_self = preg_replace("/&page=[^&]*&/", "&", $paginate_self); $paginate_self = substr($paginate_self, 1, strlen($paginate_self) - 1); if($paginate_self == '&') $paginate_self = ''; else $paginate_self = htmlentities($paginate_self); } else { $paginate_self = ''; } */ //if ( strlen($_SERVER{'REQUEST_URI'}) >= $uri_maxlength ) //{ /* It is possible to apply a /attack. A server resource is spent by making long String process inside. Although it can say that it is not great processing load, it is steadily from a small thing. However, restriction by HTTP GET is received in this case. For example http://some.url.com/archives/cat2/index.php/////////////////////////////////////////////////////////////////////////////////page/3 Umm.... It is also in such cases.... http://some.url.com/archives////////////////////////cat2/index.php/////////////////////////////////////////////////////////////////////////////////page/3 http://some.url.com///////////////////////////////////////archives////////////////////////cat2/index.php/////////////////////////////////////////////////////////////////////////////////page/3 */ //It is not secure to acquire from the above-mentioned reason to URI. //Since the URI serves as a base when it links URL again after attaching ///purposely, it unites and is also unsavory. $paginate_self = 'http://debz-di.kabocha.to/archives/cat1/perl//' . $paginate_page_selector; //} ?>

2004年01月05日

CGI-LITE1.8,2.02

CGI-LITE1.8,2.02と試してみたけれど、複数ファイルのアップロード等できちんとうごきゃーしない。(オリジナルではきちんと動かないので手を入れていたけど、不安定）どうもイロイロよくなさげだなあ。
ということで参考にしつつ１から作り直し。　なんとかうまくいくメドが立った。ふー。

投稿者 debizoh : 00:00 | コメント (0)

2004年04月08日

PerlDevKit

PerlAppためしてみてるけど、PerlAppで作成されたファイルが、元ソースでのUptime/Memory Usageよりも高い値になっている...。
ソースを隠すとか、配置とかの面から考えればいいことだけれども、サーバ負荷からいうとあまりよろしくないでんなあ。。

最適化はされてない、ってことなんだろうなあ。むむーん。

投稿者 debizoh : 00:00 | コメント (0)

2005年03月30日

PHP::SESSION

とあるWeb業者に「メンテナンスを考えて」「PHPのソースで直書きとかじゃなくてテンプレート形式でさくっとかえられるように」
というお達しを出したところ、JavaScriptで作ってやがった...。
フッターやメニュー、果てはHEADのTITLEやらCSSのLINK RELまでも...。
Script動かない環境だったら本当にまともに見れないってことになるんですが...。

それ以外も合わせて、頼んだことの10%にも満たない作業しかしてないがね。
ログインページ&会員データ登録部のPHPのサンプルソースまで付けて渡したのに...
はー、なんたることだ。ということで、もう見切りをつけにゃならんので、PHPからPerlへ書き直す。
ちょいちょいとPHP::Sessionを使ってテストしてみてはいたけれども、うまく値がSessionに入らずでどないなってんやろ思ってた。参照渡しじゃないと、値がまともに入らないという「仕様」だった。ドキュメントにもなんも書かれてないけど、refで値がハッシュなのか配列なのか、Scalarなのか見てた、と。ソース見て納得。

/tmpにセッション作るわけだから、マルチユーザなサーバじゃセキュアではない。
nobodyで読み書きできるなら、Shell上で全部見える。PHP好きじゃないからまーいいや。

投稿者 debizoh : 00:00 | コメント (0)

2005年10月26日

Excelを操作

Excelで契約書とか出したいということなので
SpreadSheet::ParseExcelと、Spreadsheet::WriteExcelをためしてみる。
確かにまあ、Excelを作れるっちゃあ作れるけどなあ・・・・と、いう感じ。
SpreadSheet::ParseExcel::SaveParserは、どうもWriteExcel側のバージョンが上がって
きちんと動かなくなってる模様。

しょうがないからParseしてWriteするために四苦八苦してみる。
Mergeの値がうまく取れてないなあ。　うーん。

Excel2002以降でって考えれば、XMLの方がよさそうなんだけどな。
業務的にどうするか、っていうのも検討事項だし、あんまりテストに時間かけてもいられへんところではある・・・。

投稿者 debizoh : 18:30 | コメント (0) | トラックバック

2005年11月06日

ハッシュ配列操作の注意

あるハッシュ配列から、一部の値だけを取得したいような場合、 keysを使うか、eachを使うかで動作が少々変わる。

while( ($key,$value) = each %hash)
{
   if ($keys eq 'nantoka')
   {
       #処理
       last;
   }
}

このような場合、１度きり、この%hashが評価されるのならばよいが、２度目には反復子(iterator ：繰り返しの位置を記憶している内部的なインデックス）が記憶されたままで、ハッシュ配列の格納数が１つ減ったりする。

反復子をリセットするにはkeysを使う。もしくは、そのように何度もループで使いまわされるハッシュ配列であるならば、上記のルーチンのようにeachでループ中にlastで抜けないこと。

ActivePerl 5.8.7 Windowsで行った場合にはそうなった。他のPlathome等では大丈夫かもしれない。

投稿者 debizoh : 13:34 | コメント (0) | トラックバック

2005年12月07日

PHPでセッション重複

この辺とか
この辺とか
で、PHP のセッション関連に触れてたわけですが、触ってた時に、こりゃぁ重複するなあ。。という感じでしたが、やっぱり重複するようです。
ネタにしてませんでしたけど。
(以下4.0.6でのソース。最新も多分そんなに変わらない）

session.c
gettimeofday(&tv, NULL);
PHP_MD5Init(&context);

sprintf(buf, "%ld%ld%0.8f", tv.tv_sec, tv.tv_usec, php_combined_lcg() * 10);
PHP_MD5Update(&context, buf, strlen(buf));

ext/standard/log.c

/*
* combinedLCG() returns a pseudo random number in the range of (0,1).
* The function combines two CGs with periods of
* 2^31 - 85 and 2^31 - 249. The period of this function
* is equal to the product of both primes.
*/

#define MODMULT(a,b,c,m,s) q = s/a;s=b*(s-a*q)-c*q;if(s<0)s+=m

double php_combined_lcg(void)
{
long q;
long z;
LCGLS_FETCH();

MODMULT(53668,40014,12211,2147483563L, LCG(s1));
MODMULT(52774,40692,3791, 2147483399L, LCG(s2));

z = LCG(s1) - LCG(s2);
if(z < 1) {
z += 2147483562;
}

return z * 4.656613e-10;
}

Cは必要に駆られないとやらないというか基本的に逃げの姿勢ですので、斜め読みしかしてません、悪しからず。

で、ロジック的に考えてみましょう。
「ランダム値は完全なランダム値にはなり得ない」ので、ミリ秒を取得した上でのランダムだから「重複しない」ということは有り得ません。
重複する可能性は低い、とは言っても重複する可能性はゼロでは無い。
ランダムだから重複しないんじゃ？という問いがあれば、ランダムだからランダム的にぶつかるのです、はい。絶対にぶつからないなら、それは固有値。

セッションとして固有なキーを渡す必要があるのなら、「本当に固有で重複しえないキーを生成」しなければなりません。
「idを生成した時点」で排他セッションファイルを生成し、ロックが完了するまで待つ、出来なければ排他ロックに失敗したということで、idを作成し直す、というロジックであれば、ユーザが待たされる時間が長くなる場合もありますが、ほぼ重複はしないでしょう。・・・というような冗長なセッション処理をお客用プログラムでは自分で書いています。（Perlでの話しですけどね）クラスタ環境ではまずいので、その場合はその処理を入れなければなりませんけど。

当該PHPのセッションID生成部ではflockはここではしていないように見えます。IDが重複してないと判断するが、最終的には（ファイル書き出しとCOOKIE格納時）重複する、というロジックになると思います。

アクセス数が多いサイトで発生する確率が上がるでしょう。そして、確率が上がるということは、不具合が発生する率も高まるということを意味します。
どこまで重複する可能性があっても良いか、というところにかかってくるのでしょうが。

www.pot.jpさんにも、セッション重複問題が書かれています。

きちんと理解していないAPIやモジュールをむやみに信用して作成するのはリスクが高いのです。
自分で書いてもリスクは同じといえば同じですが。

セッションとは、ユーザが操作したショッピングカーとの内容等を一時的に格納するために、COOKIEをブラウザに格納した上で、サーバ上にセッション情報を保存しておく、というものです。
ブラウザのCOOKIEに格納したIDから、一時的に保存したカートの中身を表示させたり、商品を追加したり、といった処理を行うのが一般的です。

ですから、重複するセッション情報があった場合、他のユーザと重複してしまうため、まずいのです。

投稿者 debizoh : 02:17 | コメント (0) | トラックバック

2006年01月16日

DatulaからBeckyへのデータコンバーター

DatulaからBeckyへのデータコンバータですが、テストした感じ、ほとんど大丈夫なようなので公開します。
要ActivePerl
要Thread::Running
Thread::Runningを使用しているので、スレッドの回収が少しは速いはずです。
なんでPerlで作るかね..っていう話もあるでしょうが・・・。
ダウンロード
使い方等は、解凍した上で、readme.txtを読んで下さい。

readme.txtの内容

Datula to Becky v2

サポートが完全に終了したDatulaからBeckyへ乗り換えるための支援スクリプトです。
メールデータ、基本アカウント情報、signatureをコピーします。

＜必要なもの＞
ActiveState ActivePerl5.8以降
Thread::Running

ActivePerlをインストールした後、
perl -MCPAN -e shell
を実行し
install Thread::Running
で、Thread::Running をCPANからインストールしてください。

尚、ActivePerlはなるべく最新のものを使ってください。
作成及びテストでは、v5.8.7 build 815を使用。

1.設定
同梱のexport.iniを書き換えてください。

1行目 Datulaのデータが格納されている先へのパス
2行目 Beckyのデータが格納されている先へのパス
3行目 Datulaのレジストリデータ(通常は、PerlScriptと同じディレクトリにおきます）
4行目 Threadを使用する数。あまり増やすとシステムが不安定になります。10以下を推奨

2.Datulaのレジストリデータを書き出してください。
Datula内のバックアップコマンドで実行すればよいです。

3.DatulaとBeckyを終了してください。

4.実行方法
　まず、コマンドプロンプトを開きます

cd このスクリプトがおかれているディレクトリ
perl output.pl

　後はのんびり待ってください。
　データ容量、DiskI/O、CPUパワー等にもよりますが、テストでは 8.5GBで40分ほどで実行が完了。

5.完了後
Datula内のメールデータ、signature以外の、振り分けや、パスワードは
初期化されますので
Beckyを実行してパスワードの再設定などを行ってください。

　尚、Beckyでフォルダを開く際に、初めての時にはインデックスファイル
　生成のために少々時間がかかります。

6.バグ/エラーなど
・Datulaのmbxからの吐き出しの際で、データ件数が多くなる場合が稀にあります。
・Perlのスレッドが異常終了して、エラーが出た場合は、
Beckyのディレクトリから、Account*.datula.mb のフォルダを全て削除し、
再実行してください。
Accaount*.datula.mb という名称は通常ではBeckyで使用されませんが、
削除する際には一応間違いが無いか気をつけてください。
　・データを書き出す際に、ウィルスチェックが利いて書き出しに失敗することがあります。
　 (ウィルスチェックプログラムの種類にもよる）実行時には一応ウィルスチェックをとめてから実行を行ってください。
　・Package化でだいたい動いていましたが、Threadの回収関連が少々怪しいため、Package化していません。

7.テスト環境
Becky v2.24.02[ja]
Datula 1.52.01
ActivePerl 5.8.7 build 815
WindowsXP SP2

8.参考
Fe's Soft http://hp.vector.co.jp/authors/VA014121/
Export from Datula GUI

Export from Datula GUIで使用されている export.cのfile seekでは、ポインタ移動が 少々まずいようです。参考にした上で改変しています。

投稿者 debizoh : 01:29 | コメント (0) | トラックバック

2006年09月09日

HNStoMovableType

HNSからMovableTypeへ移行させるためのサンプルスクリプト。
以前作って、いつか掲載しますとかいいつつ放置していたのですが掲載しときます。

Windows環境にhnsの日記ファイルをコピーしてきて、
basedirに指定して実行する。

loginuserやblogpass等は、MovableTypeで作成した上で実行。
blogidは、MTを実行させている際に、URLのパラメータ等で表示されているので、
それをメモしておく。

hns2.1.3 MT3.1ぐらいのときに確認。

要Perl5.8以降
Unicode::Japanese
XMLRPC::Lite
jcode.pl（Unicode::Japaneseで全部済むんだけど、作った時はそうしていたので・・・）

細かいことはソース見てがんばってください。HNS－＞MTのカテゴリマッピングとかもさせなきゃいけないので、細かく設定が必要になってきますので。
ソース

XML-RPCを使ってMTへ投稿をがりがりさせているという感じですので、うまく使えば別の用途にも使えます。（携帯から書き込むとか。画像の処理は別途追加しなきゃなんないけど。）

投稿者 debizoh : 11:36 | コメント (0) | トラックバック

2006年09月13日

Jcode.pmのSecurity Hole つかバグだろ

ちと古いネタになりますけども、
$Revision: 2.6 $ $Date: 2006/07/02 07:56:06 $
! Jcode.pm t/regex.t t/tr.t
Security fix by Hanabusa-san that prevents options from being eval'ed.
というのが出ておりました。

2006/9/2の日記でちょいと書いていた「Awstatsのutf8 decodeでsegfaultなんだよなあ」は、このJcode.pmの問題によって起こっていたことがわかった。（書いてから１日後ぐらいには解決していたのですが、ネタとして書くのが遅れました・・・）
リファラーの語句をUtf8Decodeさせるツール(utf8decode.pl)は、最新ではEncode.pmを使っている関係もあって、Perl5.8環境でしか動かせないが、Perl5.6なサーバで稼動させるためにカスタマイズを施したものを動かしていた。
ただ、別ユーザのところでは問題が起こってはいなかったし「特定文字」でSegfaultを起こすわけでもなさそうだったので、なんともなあ、というところではありましたが。

まあ、そういうことでライブラリで使うものもきっちり管理orアップデートを行わないといけないということですね。

投稿者 debizoh : 20:55 | コメント (0) | トラックバック

2006年11月12日

携帯メールスクリプト ubiqunのソース

実用すくりぷとん ubiqunを使って、POPで定期受信～転送をしていますが、時々転送がとまるんですなあ。

ついでに、popデータも異様に溜まりまくっている・・・。
ソースを見ると
print `$command` || &VERBOSE('error', 'error', 'ERROR: cannot execute child process. / command = ' . $command);
ということで、プロセスを立ち上げて出力を取って、出力がなければエラーということになるが、
-quietオプションをつけて立ち上げていると、子プロセスで立ち上がったものにもargvが渡るようになってしまい、「出力が全くない」ことで print || では、エラーとなりまずいような気がする。
特にメールが複数残っているような場合に転送が１個でとまるっぽい。

sub EXECUTE_CHILDPROCESS {
の中で、
$command .= '"' . $setting{'dir_program'} . $setting{'file_program'} . '" ' . $argv;
として、コマンドと引数を結合させている直前あたりに
if ( (index($argv,"-quiet") ) != -1 )
{
$replace = '-quiet';
$argv =~ s/$replace//;
}
とかいれとく。

後は、しばらく様子見ですが・・・

投稿者 debizoh : 02:14 | コメント (0) | トラックバック

2006年12月19日

fetchmail を使った転送スクリプト

fetchmailを使うと、POPで定期受信を簡単に行える。
しかし、メーリングリストにそのまま無加工で送ると、メールヘッダも無加工であるから、エラー等の際にエライことになる。
というわけで、楽をするためにスクリプトを作る。ついでに、fetchmailで受信し、メーリングリストに投げつつ、procmailで受信したサーバにprocmailを使ってstoreさせる機能を追加。

できる限りヘッダを書き換えるようにしているが、メーリングリストマネージャによっては、その他のヘッダも書き換える必要があるかもしれない。
いろいろなしがらみによって客先で担当メールアドレスを作成され、それを実社内でメーリングリストにキャストすることによって社内にもそのまま通達、ついでに自分用アドレスにStoreしときたいような場合等に使う。

まあ、あんまり一般的に使うものでもないかもしれないが、mail fromをみて、これはブロードキャストするか、remoteにstoreするだけか、みたいなことも改造すればできるわけで、考えればいろいろ使えなくはないかも。（曜日によってとかも、ちょっといじればいけるでしょうし）

fetchmail.rcで
mda "/usr/bin/perl /somewhere/mailfw.pl"

というように記述する。mailfw.plの中身は以下の通りで、localを使うのであれば、procmail.rcを適宜記述しておく。
Debian Sarge環境procmail 3.22,qmail 1.03,fetchmail 6.2.5,perl5.8.4で確認。
生田　昇さんのmime_pls http://www.cc.rim.or.jp/~ikuta/mime_pls/index.html の、mimer.plが必要。

JIS環境(日本語）でしかテストしていません。
fetchmailを動かすためにcronの設定が必要。パイプで渡すことができる環境なら、そのままパイプで渡すのもありかも。（ただ、fetchmailのmdaコマンドで動作するように作っているため、改行コードcrがdeleteされて来ない、という部分があります。変更する場合は要注意。）

スクリプトは以下。持ち帰りソースはこれ

$cache = "/somedir/cache.dat"; #cache file StorePath
$lockfile = "/somedir/locks.dat"; #lock file store path

#remoteの場合は、from,to
#localの場合は、procmailrcの場所を指定する
@post_tos =(
'remote someaddr@somedomain someaddr_to@somedomain_to',
'local procmailrcs.file',
);

%commands =(
'sendmail' => '/usr/sbin/sendmail',
'procmail' => '/usr/bin/procmail',
);

$locktimeout = 10;
$lockflag = 0;

require './somedir/mimer.pl'; #mimer.pl必須

&lock_rootin($lockfile,$locktimeout);

&make_cache;
foreach (@post_tos)
{
($deli,$from,$to) = split(/\t/,$_);
if ($deli eq "remote")
{
&go_send_remote($from,$to);
}
elsif ($deli eq "local")
{
&go_send_local($from);
}

}

sub make_cache
{
open(OUT,">$cache") or &errors;
while()
{
print OUT $_;
}
close(OUT);
}

sub go_send_local
{
my($from,$rcptto) = @_;

my($cmd) = $commands{'procmail'};

#| /usr/bin/procmail -m ./.procmailrc
open(OUT,"| $cmd -m $from") or &errors;
open(IN,"$cache");
while()
{
print OUT $_;
}
close(IN);
close(OUT);

}

sub go_send_remote
{
my($from,$rcptto) = @_;
my($skip_header,$get_fromheader,$header_ended,$headers,$check_header,$head_data,
$orgfrom,$fromheaders,$origin_post);

$header_ended = 0;
$origin_post = 0;

my($cmd) = $commands{'sendmail'};

open(OUT,"| $cmd $rcptto") or &errors;
open(IN,"$cache");

print OUT "To: <$rcptto>" . "\n";
print OUT "From: <$from>" . "\n";

$skip_header = 0;
$get_fromheader = 0;
while()
{
if ($header_ended == 0)
{
#--- MDA nara cr delete ga yuukou. ----
if ($_ eq "\n")
{
$header_ended = 1;
if ($headers ne "")
{
print OUT $headers;
}
$headers ="";
}
else
{
if ($_ =~ m/^(.*?):\s(.*?)\n$/)
{
$skip_header = 0;
$check_header = $1;
$head_data = $2;

if ($headers ne "")
{
print OUT $headers;
}
$headers ="";

if ($get_fromheader == 1)
{
$get_fromheader = 0;
$orgfrom = &decode_mime($fromheaders);
}

if ($check_header =~ /^Return-Path/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^Delivered-To/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^X-Original-To/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^Delivered-To/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^Cc/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^To/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^From/i)
{
$get_fromheader = 1;
$skip_header = 1;
$fromheaders .= $head_data . "\n";
next;
}

$headers .= $_;
next;
}
elsif($skip_header == 1)
{
if ($get_fromheader == 1)
{
$fromheaders .= $_;
}
next;
}
else
{
$headers .= $_;
}
}
}
elsif($origin_post == 0)
{
print OUT "\n";
print OUT "This is Mail Transfer Program.\n";
print OUT "Original from: " . $orgfrom . "\n";
$origin_post = 1;

print OUT $_;
}
else
{
print OUT $_;
}
}
close(IN);
close(OUT);

}

unlink($cache);
&end_lock;

sub decode_mime
{
my($orgfrom) = $_[0];
my($mimes) = "=?ISO-2022-JP";

if ($orgfrom =~ m/$mimes/)
{
$decode_from = &mimedecode($orgfrom);
return($decode_from);
}

return($orgfrom);

}

sub errors
{
if ($lockflag != 0)
{
&end_lock;
}

exit 1;
}

sub lock_rootin {
my($tmppath,$locktimeout) = @_;
$lockflag++;
if (-e $tmppath ) {
open(LOCK, "$tmppath") or &errors;
}
else
{
open(LOCK,">$tmppath") or &errors;
}
eval
{
$lockstart = 1;
local $SIG{ALRM} = sub { die "time out" }; # 時間が来たら抜け出す
alarm($locktimeout); # 制限時間
flock(LOCK, 2);
alarm(0);
};
if ($@ =~ /time out/) {
$lockstart = 0;
&end_lock;
&errors;
}
}

sub end_lock {
local($i);
for ($i = 1; $i <= $lockflag ; $i++)
{
if ($i == 1 )
{
flock(LOCK,8);
close(LOCK);
}
if ($i == 2 )
{
flock(LOCK2,8);
close(LOCK2);
}
if ($i == 3 )
{
flock(LOCK3,8);
close(LOCK3);
}
if ($i == 4 )
{
flock(LOCK4,8);
close(LOCK4);
}
}
$lockflag = 0;

}

投稿者 debizoh : 04:39 | コメント (0) | トラックバック