diff options
Diffstat (limited to 'fml')
80 files changed, 5979 insertions, 0 deletions
diff --git a/fml/INSTALL.sh b/fml/INSTALL.sh new file mode 100755 index 00000000..2d688363 --- /dev/null +++ b/fml/INSTALL.sh @@ -0,0 +1,44 @@ +#!/bin/sh +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +# Run this from the top-level fml source directory. + +PATH=/bin:/usr/bin:/usr/sbin:/usr/etc:/sbin:/etc +umask 022 + +### configurations ### +version=5.000 +prefix_dir=/usr/local +config_dir=/etc/fml +libexec_dir=$prefix_dir/libexec/fml +lib_dir=$prefix_dir/lib/fml +###################### + +if [ ! -d $config_dir ];then + echo "I cannot find $config_dir" + exit 1 +fi + +for dir in $config_dir/defaults $config_dir/defaults/$version +do + test -d $dir || mkdir $dir +done + +cp etc/main.cf $config_dir/main.cf +cp etc/default_config.cf $config_dir/defaults/$version + +echo debug now ... +ln -s $PWD/libexec $libexec_dir/$version +ln -s $PWD/lib $lib_dir/$version + +echo "please link" +echo "% ln -s $PWD/etc/config.cf /var/spool/ml/elena/config.cf" + +exit 0 diff --git a/fml/Makefile b/fml/Makefile new file mode 100644 index 00000000..18eaf07c --- /dev/null +++ b/fml/Makefile @@ -0,0 +1,40 @@ +PERL = perl -w -I ./lib/fml5 -I ./lib/CPAN -I ./lib/3RDPARTY -I ./lib + +all: test + +scan: + @ cvs -n update 2>&1 |grep -v : || echo '' + +update: + @ cvs update -dAP|grep -v : || echo '' + +test: test2 + +test1: + @ cat w/example |\ + perl -w libexec/distribute etc/default_config.cf etc/config.cf + +test2: + @ cat w/example |\ + perl -w libexec/fml.pl /var/spool/ml/elena + +test3: + @ echo '-- test in the case where Socket6 fail' + @ cat w/example |\ + /usr/pkg/bin/perl -w libexec/fml.pl /var/spool/ml/elena + +check: + @ for x in `find lib* -type f -print|grep pm|grep -v CPAN` ; do $(PERL) -c $$x || echo '' ;done + +clean: + @ find . |grep '~' |perl -nple unlink + +link: + rm -f FML Netlib IO + ln -s lib/fml5/FML . + ln -s lib/fml5/Netlib . + ln -s lib/fml5/IO . + (cd libexec; ln -s fmlwrapper fml.pl) + +hier: + perl bin/show_hierarchy.pl FML/libkern.pl | uniq diff --git a/fml/TODO b/fml/TODO new file mode 100644 index 00000000..a91bf2b6 --- /dev/null +++ b/fml/TODO @@ -0,0 +1,9 @@ +* general + + queue manager + +* SMTP + + outgoing address + + direct exec $program on the disk NOT IPC. diff --git a/fml/bin/fmldoc b/fml/bin/fmldoc new file mode 100755 index 00000000..48552a86 --- /dev/null +++ b/fml/bin/fmldoc @@ -0,0 +1,27 @@ +#!/usr/local/bin/perl +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. +# +# $FML$ +# + +=head1 NAME + +fmldoc -- wrapper for pod2man + +=head1 SYNOPSIS + +fmldoc filename + +=head1 DESCRIPTION + +=cut + +for $file (@ARGV) { + $file =~ s@::@/@g; + system "pod2man $file | nroff -man |less"; +} + +1; diff --git a/fml/bin/show_hierarchy.pl b/fml/bin/show_hierarchy.pl new file mode 100755 index 00000000..ce6cd775 --- /dev/null +++ b/fml/bin/show_hierarchy.pl @@ -0,0 +1,142 @@ +#!/usr/local/bin/perl +# +# $Id$ +# + +use lib qw(./lib/3RDPARTY ./lib/fml5 ./lib/CPAN ./lib); +use strict; +use vars qw($Count %Count $debug $verbose %IgnoreList); + +%IgnoreList = ( + 'Carp' => 1, + 'Exporter' => 1, + 'FileHandle' => 1, + 'DynaLoader' => 1, + 'AutoLoader' => 1, + ); + +for (@ARGV) { load( $_ );} + + +sub load +{ + my ($f) = @_; + my $name = $f; + + return if $IgnoreList{ $name }; + + $Count++; + if ($Count > 32) { die("infinite loop!\n");} + + $f =~ s@::@/@g; + for my $dir (@INC) { + if (-f "$dir/$f.pm") { + $f = "$dir/$f.pm"; + last; + } + if (-f "$dir/$f.pl") { + $f = "$dir/$f.pl"; + last; + } + } + + unless (-f $f) { + P( "not found: $f" ) if $debug;; + $Count--; + return; + } + + + if ( $Count{ $f } ) { + P( "$f is recursive" ) if $debug;; + $Count--; + return; + } + else { + $Count{ $f } = 1; + } + + use FileHandle; + my $fh = new FileHandle $f; + print "--- open $f\n" if $debug; + + + ### dynamic scope to count up recursive conditions + local(%Count) if $Count == 2; + + + + if (defined $fh) { + my $file = ''; + my $comment = ''; + my $current_function = ''; + my %function_hach = (); + my $pat = '$0 eq __FILE__'; + + while (<$fh>) { + last if /$pat/; + last if /__END__/; + + next if /^\s*\#/; + next if /^\s*Log/; + + # ignore comments + $comment = 1 if /^=/; + $comment = 0 if /^=cut/; + next if $comment; + + chop; + + if (/^sub (\S+)/) { + $current_function = $1; + } + + # ignore these since they are too many. + if (/(use|require)\s+(Carp|Exporter|DynaLoader|AutoLoader)/) { + next; + } + + if (/(use|require)\s+([A-Z]\S+[a-zA-Z0-9])/) { + unless ( $function_hach{ $current_function } ) { + if ($verbose) { + &P(); + &P( "${name}::". $current_function ); + } + $function_hach{ $current_function } = 1; + } + + &P() if $Count == 1; + &P() if $Count == 2; + $verbose ? &P( $_ , $. ) : &P( $_ ); + $file = $2; + $file =~ s/\"//g; + $file =~ s/\'//g; + if ($file =~ /^[a-z]/) { + ; + } + else { + P( "\t($Count)load $file" ) if $debug; + load($file); + } + } + } + + $fh->close if defined $fh; + } + + $Count--; +} + + +sub P +{ + my ($s, $lc) = @_; + + $s =~ s/^\s+//o; + print " " x ( $Count - 1 ); + printf "%4d> ", $lc if $lc; + print $s, "\n"; +} + + +1; diff --git a/fml/bin/show_modules.sh b/fml/bin/show_modules.sh new file mode 100755 index 00000000..ce682495 --- /dev/null +++ b/fml/bin/show_modules.sh @@ -0,0 +1,6 @@ +#!/bin/sh + +for x in libexec/fml.pl FML/*pm +do + sed '/=head1/,/=cut/d' $x |less +done diff --git a/fml/curproc.ja.html b/fml/curproc.ja.html new file mode 100644 index 00000000..6e144db7 --- /dev/null +++ b/fml/curproc.ja.html @@ -0,0 +1,44 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +$curproc (current process struct) 構造体のうちわけ +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +<CENTER> +<EM>$curproc</EM> +(current process struct) 構造体のうちわけ +</CENTER> + +<PRE> + +$curproc FML::Process::Kernel オブジェクト + + config FML::Config オブジェクト + + credential FML::Credential オブジェクト + + incoming_mail (単なるキーワード) + ヘッダ FML::Header オブジェクト + メール本文 FML::Body オブジェクト + + article (単なるキーワード) + ヘッダ FML::Header オブジェクト + メール本文 FML::Body オブジェクト + + reply_messages (単なるキーワード) + +</PRE> + +オペレーションは各オブジェクトのメソッドが責任を持って実行する。 + + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/doc/00_IDEA b/fml/doc/00_IDEA new file mode 100644 index 00000000..c09f60d9 --- /dev/null +++ b/fml/doc/00_IDEA @@ -0,0 +1,264 @@ + fml5 project + + +○ 基本理念 + + (仮称) fml5 == Fml Modular Listmanager based on perl 5 + (recursive definition) + + sendmail -> postfix 的な置き換えプログラム + 例えば + /etc/aliaes や .forward はそのまま使いつづけられる + しかし sendmail.cf は解釈しないといったイメージ + + /var/spool/ml + /var/spool/ml/ML名 + + という構造は残したいとおもうが、 + それ以外の互換性を保証するかはかなり不明 + + Q: ? ~ユーザ名/fml/ML名 + suEXEC みたいなものかい? + + ユーザが死にそうにいるサーバ上では uniqueness をチェッ + クするのがとても大変そう？ + + +○ fml.pl は wrapper で + + /usr/local/libexec/fml/$VERSION/ ... + + LDAP とか SQL をしゃべれてほしいですな > Netscape + + +○ メインプログラムディレクトリ階層の例 + ( 現在の /usr/local/local/fml にあたるもの ) + ports, packages, RPM, .deb フレンドリィに(?) + + /usr/local/libexec/fml/ + + /usr/local/libexec/fml/distribute (配送プログラム) + /usr/local/libexec/fml/command (コマンド処理プログラム) + /usr/local/libexec/fml/mead (エラー解析) + /usr/local/libexec/fml/confirmd + + 注: --ctladdr はつかわない。できるだけ DO NOT PARSE + でないと機械的な処理がしにくいため + # 例えば CGI では include-ctl ファイルの編集の際 + s/distribute/command/g + するだけの方が楽などといった具合(?) + + /usr/local/libexec/fml/emul/ + + /usr/local/libexec/fml/emul/fml.pl + --ctladdr なしは /usr/local/libexec/fml/distribute を + --ctladdr つきは /usr/local/libexec/fml/command を実行する + + /usr/local/libexec/fml/emul/XXX + 例: emul/listserv + + + /usr/local/lib/fml/ + ドキュメントや perl module などをおく ? + + /usr/local/lib/fml/doc/text/ + /usr/local/lib/fml/doc/html/ + /usr/local/lib/fml/doc/sgml/ + /usr/local/lib/fml/doc/pod/ + /usr/local/lib/fml/doc/man/ + /usr/local/lib/fml/doc/jman/ + + /usr/local/lib/fml/lib/base/Proc.pm + /usr/local/lib/fml/lib/CPAN/Mail/ + /usr/local/lib/fml/lib/Jcode/Jcode.pm + /usr/local/lib/fml/lib/gnu/ + /usr/local/lib/fml/lib/3rdparty/ + + /usr/local/lib/fml/messages/ + /usr/local/lib/fml/makefml/ + + /usr/local/lib/fml/examples/ + /usr/local/lib/fml/examples/www/ + /usr/local/lib/fml/examples/databases/ + + /usr/local/lib/fml/contrib/ + + +○ 基本設定の例 + + ( makefml が使うため, virtual domain/host を考慮する ) + + /etc/fml/$domain/fml.cf + /etc/fml/$domain/cgi.cf + + こうすれば + # makefml newml elena@fml.org + # makefml newml elena@nuinui.net + といった操作でバーチャルドメインの場合に簡単にできないか? + + elena ML + /var/spool/ml/elena/設定ファイル (仮称: config.cf ) + # もっと良い名前募集中 + + + :include:/var/spool/ml/elena は + + "| /usr/local/libexec/fml/distribute /var/spool/ml/elena" + + :include:/var/spool/ml/elena-ctl は + + "| /usr/local/libexec/fml/command /var/spool/ml/elena" + + を呼び出す。 + + Q: 実は実体は1つで、$0 で処理が分かれるようにしていてもよい + + +○ 再利用可能性 + + たとえば confirmation module の例 + + subscribe エンジン ---> confirmation module + モデレータ ---> confirmation module + confirmd ---> confirmation module + + /usr/local/lib/fml/lib/base/Confirm.pm + + +○ 設定ファイル + + 問題点 + perl でかくと parser がかけない(perl が柔軟過ぎるから) + 1/0 はいやん、yes/no のほうがまし + 配列が表現できない + 型チェックをしたいのだが… + + + config.cf の例 # 段落区切り ( postfix とおなじ形式で ) + + # これは自動設定されるはず + # myhomedir = /var/spool/ml/elena + + myfqdn = ahodori.fml.org + mydomain = fml.org + + mail_list = elena@$mydomain + control_address = elena-ctl@$mydomain + + # メンバーリスト関係 + members_maps = $myhomedir/members + admin_members_maps = $myhomedir/members-admin + + # definition of recipients: fml uses recipient lists in this order + # [a-z]+: のうち file: だけは省略しても良い + # これで配列の表現ができる + recipients_maps = $myhomedir/recipients + file:$myhomedir/actives + mysql:$sysconfdir/mysql.cf + + + # makefml add の際にはどの maps をアップデートするか? + # たとえばファイルに追加であって、mysql へではない + # XXX この名前づけルールは良くないと思う > postfix + # XXX もっとよい名前を + recipient_database = $myhomedir/recipients + + + # かならず use_* と *_type がこんび(か?) + use_verps = yes + verps_type = qmail + + + # 配送モード ( REJECT_POST_HANDLER をやめよう ) + # distribute_mode = forward + distribute_mode = forward_if_moderator_allow + + # $PERMIT_POST_FROM + allow_post_from = reject_system_accounts + members_only + reject + + # $PERMIT_COMMAND_FORM (?) + allow_command_from = reject_system_accounts + members_only + ignore + + # + distribute_restrictions = reject_system_accounts + members_only + reject + + command_restrictions = reject_system_accounts + members_only + reject + + + # 逆にモデレータ は use_moderator (にすると変な例?) + use_moderator = yes + moderator_type = otp + moderator_maps = $myhomedir/moderators + + # LDAP + LDAP::HOST = + LDAP::PORT = + + + +○ フック？ + + 別案１ + + # hooks + hooks = $myhomedir/hooks.ph + + 別案２ + + =head1 configurations + + postfix スタイル（なんですよ、これは） + + =head1 hooks + =cut + + # 現在の LOCAL_CONFIG で別れ目になる行 + # HOOK + + +○ 多国語化 + + 「developpers はメッセージの他国語化は前提にしてくれればいいだ + けで、べつに英語の見本を書かなくてもいいですよ〜ん」 + + この時代、日本人が運用していてもその ML のメンバーが外国人のば + あいはあります。だからサポートしたいです。 + + また、IETF では来年あたりに、エラーメッセージなどの多国語化問 + 題とかあるので、MLM (MTA もどき)であっても、多国語かは必要とお + もいます。＃なにをもってえらーめっせーじかによりますけど… + + +○ 設定ファイルのロード順 + + + 現在の cf ですら設定してる項目が多すぎる + 「実はこんな項目もconfig.phで設定されちゃっているのね」はだめ + + あどれす + POST_RESTRICTION + COMMAND_RESTRICTION + REGISTRATION_TYPE auto_confirmation (とかか?) + + 以外はデフォルトのままにしたいなぁ。 + ぼく、差分だけが一画面くらいあるだけなのが希望ですぅ。 + + ということは + + use FML::LoadConfig; + my $rcf = new FML::LoadConfig; + $rcf->load( /usr/local/fml/lib/$VERSION/etc/default_config.cf ); + $rcf->load( /etc/fml/$DOMAIN/default_config.cf ); + $rcf->load( /var/spool/ml/elena/config.cf ); + + とかいうローディングをしないといけないような気がする + + ＊ メニューで明示的に変更すると、それだけは新たに付け加わる > config.cf diff --git a/fml/doc/__template.ja.html b/fml/doc/__template.ja.html new file mode 100644 index 00000000..5a8af747 --- /dev/null +++ b/fml/doc/__template.ja.html @@ -0,0 +1,18 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> + ... title ... +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + + + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/doc/architecture.gif b/fml/doc/architecture.gif Binary files differnew file mode 100644 index 00000000..4f185758 --- /dev/null +++ b/fml/doc/architecture.gif diff --git a/fml/doc/architecture.html b/fml/doc/architecture.html new file mode 100644 index 00000000..f5e59edc --- /dev/null +++ b/fml/doc/architecture.html @@ -0,0 +1,20 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> + ... title ... +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +<CENTER> +<IMG SRC="architecture.gif" ALIGH=CENTER> +</CENTER> + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/doc/components.ja.html b/fml/doc/components.ja.html new file mode 100644 index 00000000..748e632d --- /dev/null +++ b/fml/doc/components.ja.html @@ -0,0 +1,32 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +コンポーネント +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> +<PRE> + + fml/{distribute,command, ... } + ||| + -------- 乖離層 -------- + ||| + FML::BaseSystem + | | + FML::Config | + | | logging() + | | | | + file DBMS file syslog(3) +</PRE> + +FML::BaseSystem は設定の保守とログとりをサポートする最低限の基本システ +ムのクラスといえる。 + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/doc/dirhier.ja.html b/fml/doc/dirhier.ja.html new file mode 100644 index 00000000..151368de --- /dev/null +++ b/fml/doc/dirhier.ja.html @@ -0,0 +1,53 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +ディレクトリ構造 +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +<P> 実際にインストールされる場所は、次のような場所。 + <PRE> + /etc/fml/ + /usr/local/lib/fml/$VERSION/ + /usr/local/libexec/fml/$VERSION/ + /usr/share/doc/fml/$VERSION/ + </PRE> + +<TABLE BORDER=4> + <TR> + <TD> ディレクトリ + <TD> 説明 + + <TR> + <TD> doc/ + <TD> ドキュメント + + <TR> + <TD> etc/ + <TD> configurations + + <TR> + <TD> lib/ + <TD> + <A HREF="../lib/index.ja.html"> + ベンダーごとのサブディレクトリ + </A> + + <TR> + <TD> libexec/ + <TD> + 実行されるプログラムの実体。 + もっともすぐにモジュールを + 呼び出すので wrapper というべきだろう。 + +</TABLE> + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/doc/index.ja.html b/fml/doc/index.ja.html new file mode 100644 index 00000000..160cc67c --- /dev/null +++ b/fml/doc/index.ja.html @@ -0,0 +1,29 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +fml5 documents +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +<UL> + <LI> + <A HREF="interfaces.ja.html"> + モジュール間インターフェイス + </A> + + <LI> + <A HREF="modules.ja.html"> + モジュール's + </A> + +</UL> + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/doc/interfaces.ja.html b/fml/doc/interfaces.ja.html new file mode 100644 index 00000000..aad5871e --- /dev/null +++ b/fml/doc/interfaces.ja.html @@ -0,0 +1,67 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +インターフェイス仕様 +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +<CENTER> +インターフェイス仕様 (原案のメモ(注: 単なる走り書き)) +</CENTER> + +<P> <EM>基本的なスタイル</EM> +<UL> + <LI> + Perl ではポリモーフィズムと実行時バインディングができることに + は重視すること。多重継承などに頭を使うより + ポリモーフィズムと実行時バインディングによる + コンポーネント指向ぽい方向性を模索する。 + + <LI> + Perl 5 のパッケージを使った、オブジェクトぽい書き方は + 変数自身が自分のパッケージをしっているので、 + 単にパッケージ修飾(例: :: )を使わなくてもよいくらいに + 思う方がよい。 + + <LI> + そのために、 + 再利用性と抽象度を高くしたインターフェイスは + オブジェクトぽい書きかたが良さそう。 + + <LI> + perl 5 だと必然的にオブジェクトぽくなってしまうが、 + オブジェクト、オブジェクト、オブジェクトし過ぎないように + バランス感覚に注意しよう。 + + <LI> + 他人のモジュールを使う場合はともかく、 + 自分達で書くモジュールでの + ”深い”継承はできるだけ避けたい。 + 何でも深くすればよいというものではないでしょう。 +</UL> + +<P> <EM>メイン → モジュールの基本的な形の例:</EM> + libexec/ や libkern.pl にある関数は、 + main:: に記述される部分は基本的なフローを記述している。 + これらは基本的な枠組を示すものであるため、 + $CurProc (C でいえば struct *curproc にあたるもの) + を受け渡す、構造化プログラミング的な書き方をしている。 + <PRE> + + </PRE> + +<P> <EM>モジュール → モジュール </EM> + <BR> + しかし、そのひとつ下の層、そしてさらにその下では、 + 再利用性とポリモーフィズムに傾いた方がよさそうにおもえる。 + + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/doc/menubar.ja.html b/fml/doc/menubar.ja.html new file mode 100644 index 00000000..222b2889 --- /dev/null +++ b/fml/doc/menubar.ja.html @@ -0,0 +1,79 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +fml5 homepage menubar +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + + +<P> ある程度形のあるもの +<UL> + <LI> + <A HREF="../libexec/boot.ja.html" TARGET="right"> + ブートの仕方 + </A> +</UL> + +<P> 構想 +<UL> + <LI> + <A HREF="objects.ja.html" TARGET="right"> + 目的 + </A> + + <LI> + <A HREF="refactoring.ja.html" TARGET="right"> + アイデアのまとめ + </A> + + <LI> + <A HREF="components.ja.html" TARGET="right"> + コンポーネント指向 + </A> + + <LI> + <A HREF="architecture.html" TARGET="right"> + アーキテクチャ + </A> + + <LI> + <A HREF="../curproc.ja.html" TARGET="right"> + プロセス構造体 + </A> + + <LI> + <A HREF="interfaces.ja.html" TARGET="right"> + モジュール間インターフェイス案 + </A> + + <LI> + モジュール例 + <BR> + <A HREF="../lib/fml5/FML/index.ja.html" TARGET="right"> + FML::* クラス + </A> + <BR> + <A HREF="terms.ja.html" TARGET="right"> + FML::* 用語集 + </A> + + <LI> + <A HREF="dirhier.ja.html" TARGET="right"> + ディレクトリの階層構造 + </A> + + <LI> + <A HREF="releng.ja.html" TARGET="right"> + リリースエンジニアリング + </A> +</UL> + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/doc/modules.ja.html b/fml/doc/modules.ja.html new file mode 100644 index 00000000..83819912 --- /dev/null +++ b/fml/doc/modules.ja.html @@ -0,0 +1,51 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> + ... title ... +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + + +<P>今あるモジュールの説明 + +<TABLE BORDER=4> + <TR> + <TD> モジュール + <TD> 説明 + + + <TR> + <TD> FML::LoadConfig + <TD> 設定ファイルを読み込みハッシュに入れる。 + + + <TR> + <TD> FML::File + <TD> + ログファイルに記録するインタフェイス。 + 将来は syslog(3) へとばすことができるとなおよい。 + まず間違いなくほとんど全てのルーティンが + use するべきもの。これをしないと Log() が + 使えないから :-) + + <TR> + <TD> FML::Date + <TD> + いろいろな型の日付関連のフォーマッティングのため + + <TR> + <TD> FML::String + <TD> 文字列操作関数へのインターフェイス + +</TABLE> + + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/doc/objects.ja.html b/fml/doc/objects.ja.html new file mode 100644 index 00000000..873da858 --- /dev/null +++ b/fml/doc/objects.ja.html @@ -0,0 +1,62 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +目的 +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +<P> fml5 プロジェクトの目的 + +<UL> + <LI> <A HREF="refactoring.ja.html">再構想 (refactoring)</A> + <LI> <A HREF="releng.ja.html">新リリースエンジニアリング</A> + <LI> 設定ファイルとメニュープログラムの負荷を少なく + <LI> 乖離層 + <UL> + <LI> バージョンアップを簡単にできるように + <LI> CPAN モジュール使いまくり + <BR> + (ただし、できるだけ直接使うより、 + 一層被せておくほうがよい) + <LI> 3rd party 用ディレクトリ + </UL> + + <LI> 統一化されたメンバーリストなどへのアクセスをできるだけ抽象化する。 + <UL> + <LI> ファイル + <LI> /etc/group + <LI> NIS + <LI> SQL + <LI> LDAP + <LI> SSRP (?) + </UL> + 実際には効率の問題もあり、 + あらゆる抽象化は重たくなってしまう。そこで、 + 全部は抽象化できずに SMTP ライブラリにも一部いってしまうが、 + この二箇所におしこめること。 + + <LI> CUI (makefml) インターフェイスおよび CGI インターフェイス + <BR> + これは従来通りのもの。 + <BR> + ただしより統合化され、 + よりメニューなどが書きやすいものであるように + + <LI> IPv4/IPv6 ready +</UL> + +<!-- =================================================================== --> + +<CENTER> +アーキテクチャア・イメージ +<IMG SRC="architecture.gif" ALIGH=CENTER> +</CENTER> + +</BODY> +</HTML> diff --git a/fml/doc/refactoring.ja.html b/fml/doc/refactoring.ja.html new file mode 100644 index 00000000..a7ec77c4 --- /dev/null +++ b/fml/doc/refactoring.ja.html @@ -0,0 +1,137 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +fml5 [ fml リファクトリング プロジェクト (Refactroing Project) ] +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> + +<CENTER> +fml5 [ fml リファクトリング プロジェクト (Refactroing Project) ] +</CENTER> + +<P> いくつかのアイデア + +<TABLE BORDER=4> + <TR> + <TD> status + <TD> <EM>項目</EM> + <TD> 備考 + + <TR> + <TD> + <TD> <EM>ライセンス</EM> + <BR> + ライセンスを Perl 準拠へ変更する + <TD> + + <TR> + <TD> + <TD> <EM>イメージ/モティーフ</EM> + <BR> + fml4 から fml5 へは、sendmail から postfix への移行のようなイメージで + <BR> + 最低限の config.ph コンバータは用意する。 + + <TR> + <TD> + <TD> + <EM> メインプログラムの wrapper (乖離層) </EM> + バージョン管理やデバッグを簡単にするための乖離層 + <PRE> + fml.pl --- /etc/fml/wrapper.cf ---> fml/$VERSION/libexec/distribute + </PRE> + + <TR> + <TD> + <TD> + <EM>再利用性</EM> + <BR> + 自主開発はできるだけ避ける。 + <BR> + 可能な限りあらゆる CPAN モジュールなどを使う。 + また、利用する場合にも乖離層を設ける。 + <PRE> + FML::モジュール → 乖離層 → CPAN/モジュール + </PRE> + <TD> + <A HREF="interfaces.ja.html">インターフェイス仕様</A> + + <TR> + <TD> + <TD> <EM>設定ファイル形式</EM> + <UL> + <LI> cf と config.ph を統合化する + <LI> 配列を表現できる形式 + <LI> メニュープログラムが楽できるフォーマットを + <LI> 原則として”設定ファイル”という名のものは + どれも同じフォーマットとする。 + </UL> + <TD> + + <TR> + <TD> + <TD> + <EM> 変数名ルールの統一 </EM> + <UL> + <LI> USE_機能 + <LI> 機能_TYPE + <LI> 機能_ATTRIBUTES + </UL> + <BR> + ”USE_ほえ”および”ほえ_TYPE”形式か？ + また、NOT_USE などは禁止する( default_config に書くこと)。 + <BR> + attribute にあたるものが + 群れになってしまうのはしょうがない。しかし、 + 配列表現が可能なため、現在の ifdef の群れで表現する + ようなことが少なくなるはず。 + + <TR> + <TD> + <TD> + <EM> 関数名ルールの統一 </EM> + <BR> + main:: スペースに出てくるものは従来通り X11 風準拠に。 + <BR> + メソッドは他のモジュールにあるようなそれっぽい小文字の名前をつける。 + <BR> + lisp 的要素を廃止する。 + <BR> + 参考文献 Perl Cookbook として、 + そこにあるようなシンタックス風を推奨する？例: + <PRE> + MemberP() -> IsMember() + </PRE> + + + <TR> + <TD> + <TD> + <EM> queue manager </EM> + <BR> + 再送処理のため (e.g. smtpfeed ) + + <TR> + <TD> + <TD> + <EM> tools </EM> + <BR> + BSD make を使わない。 + <BR> + C 言語ではないので、autoconf は特には必要ないと思う。 + しかしながら configure という名前のスクリプトを（フェイクでも） + 用意することはよいことかもしれない。 + そのスクリプトは例えば + IPv6 ready か否かを決めるために使われるだろう。 + + +</TABLE> + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/doc/releng.ja.html b/fml/doc/releng.ja.html new file mode 100644 index 00000000..e011eae7 --- /dev/null +++ b/fml/doc/releng.ja.html @@ -0,0 +1,51 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> + ... title ... +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +<P> + アーキテクトでも、デベロッパーに偏ってもいけない。 + 抽象化に萌過ぎても、オブジェクト指向分析に燃え過ぎてもいけない。 + 中庸であり、一カ月単位でフィードバックしながら + プロジェクトの計画とコードレビューを行なうこと。 + + +<P> 月単位でのリリースエンジニアリングの原案 + +<TABLE> + <TR> + <TD> 最初の 4〜5日 + <TD> 計画を練り直す。 + <BR> + リリースエンジニアリングプロセス中の + 20 ％程度はこの計画に費やすこと + + <TR> + <TD> 2〜3 週間 + <TD> コードを書く + + <TR> + <TD> 最終週 + <TD> ドキュメントを見直す、およびコードレビュー + + <TR> + <TD> 月の切れ目 + <TD> まぁまぁ大丈夫ぽい snapshot を出してみる。 + alpha-0, + alpha-1, + alpha-2, ... + +</TABLE> + + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/doc/terms.ja.html b/fml/doc/terms.ja.html new file mode 100644 index 00000000..3e5dbb2c --- /dev/null +++ b/fml/doc/terms.ja.html @@ -0,0 +1,72 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +関数名および変数名に関連した用語のまとめ +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +<CENTER> +関数名および変数名に関連した用語のまとめ +</CENTER> + +<TABLE BORDER=4> + <TR> + <TD> 用語/単語の省略形 + <TD> 説明 + + <TR> + <TD> STR + <TD> 文字列 ( string ) の略 + + <TR> + <TD> 日本語コードの略称 + <TD> JIS SJIS EUC などおなじみのもの… + + <TR> + <TD> 2 + <TD> + to と発音が一緒のため省略形としてよく使う。 + 類似品として 4 ( for の意味)もある + <BR> + 例: STR2EUC (STRing to EUC の略) + <BR> + <PRE> + use String qw(STR2EUC); + $euc_string = &STR2EUC($string); + </PRE> + + <TR> + <TD> 4 + <TD> for と発音が同じために用いる。 + <BR> + 例: まだなし + + <TR> + <TD> fh + <TD> ファイルハンドラ( file handler ) + + <TR> + <TD> dh + <TD> ディレクトリハンドラ( directory handler ) + + <TR> + <TD> _なになに + <TD> 慣習的にパッケージ、クラス、オブジェクト内部で使う + 変数や関数名に _ ではじまるキーワードを使う。 + + <TR> + <TD> CurProc もしくは curproc + <TD> ”current process 構造体”の略 + + +</TABLE> + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/etc/config.cf b/fml/etc/config.cf new file mode 100644 index 00000000..b214c882 --- /dev/null +++ b/fml/etc/config.cf @@ -0,0 +1,64 @@ +=head1 configurations + +DOMAIN = fml.org +FQDN = ahodori.fml.org + +ml_home_dir = /var/spool/ml/elena + + +=head2 ロック + +lock_dir = $ml_home_dir/var/lock + +lock_file = $lock_dir/simplelock + +lock_type = flock + + +=head2 アクセス制御 + +# 配列表現には本質的に + +# 現在の PERMIT_POST_FROM と REJECT_ADDR をがったいしたもの +POST_RESTRICTIONS = reject_system_accounts + permit_members_only + reject + +# 現在の PERMIT_COMMAND_FROM と REJECT_ADDR をがったいしたもの +COMMAND_RESTRICTIONS = reject_system_accounts + permit_members_only + reject + +member_maps = file:$ml_home_dir/members + +#recipient_maps = file:w/members +# unix.group:fml +recipient_maps = file:w/members + +recipient_limit = 2 + +mta = [::1]:25 + 127.0.0.1:25 + 192.168.148.193:25 + 192.168.148.194:25 + +=head2 すぷーる + +sequence_file = $ml_home_dir/seq + +use_spool = yes + +spool_dir = $ml_home_dir/spool + +spool_type = plane + + +=head1 hooks +=cut + +# 現在の LOCAL_CONFIG で別れ目になる行 +# HOOK + +print "run hooks here.\n"; + +1; diff --git a/fml/etc/default_config.cf b/fml/etc/default_config.cf new file mode 100644 index 00000000..01769ee2 --- /dev/null +++ b/fml/etc/default_config.cf @@ -0,0 +1,24 @@ +### +### basic logging +### +# logfile +logfile = /tmp/log + + +### +### Section: Header Manipulations +### + +header_checks = validate_message_id + verify_unique_x_ml_info + verify_unique_list_post + +header_rewrite_rules = add_rfc2369 + + + + +### +### default_config.cf file ends here. +### +=cut diff --git a/fml/etc/defaults/acl.cf.ja b/fml/etc/defaults/acl.cf.ja new file mode 100644 index 00000000..1dec98b0 --- /dev/null +++ b/fml/etc/defaults/acl.cf.ja @@ -0,0 +1,27 @@ +=head2 アクセス制御 + +# 配列表現には本質的に + +# 現在の PERMIT_POST_FROM と REJECT_ADDR をがったいしたもの +POST_RESTRICTIONS = reject_system_accounts + permit_members_only + reject + +# 現在の PERMIT_COMMAND_FROM と REJECT_ADDR をがったいしたもの +COMMAND_RESTRICTIONS = reject_system_accounts + permit_members_only + reject + +member_maps = file:$ml_home_dir/members + +#recipient_maps = file:w/members +# unix.group:fml +recipient_maps = file:w/members + +recipient_limit = 2 + +mta = [::1]:25 + 127.0.0.1:25 + 192.168.148.193:25 + 192.168.148.194:25 + diff --git a/fml/etc/defaults/basic.cf.ja b/fml/etc/defaults/basic.cf.ja new file mode 100644 index 00000000..2b4eb6ea --- /dev/null +++ b/fml/etc/defaults/basic.cf.ja @@ -0,0 +1,8 @@ +=head1 configurations + +DOMAIN = fml.org +FQDN = ahodori.fml.org + +ml_home_dir = /var/spool/ml/elena + + diff --git a/fml/etc/defaults/config.cf.ja b/fml/etc/defaults/config.cf.ja new file mode 100644 index 00000000..8ada6bbb --- /dev/null +++ b/fml/etc/defaults/config.cf.ja @@ -0,0 +1,11 @@ +# import *.cf here + +=head1 hooks +=cut + +# 現在の LOCAL_CONFIG で別れ目になる行 +# HOOK + +print "run hooks here.\n"; + +1; diff --git a/fml/etc/defaults/lock.cf.ja b/fml/etc/defaults/lock.cf.ja new file mode 100644 index 00000000..c7ee39d0 --- /dev/null +++ b/fml/etc/defaults/lock.cf.ja @@ -0,0 +1,8 @@ +=head2 ロック + +lock_dir = $ml_home_dir/var/lock + +lock_file = $lock_dir/simplelock + +lock_type = flock + diff --git a/fml/etc/defaults/spool.cf.ja b/fml/etc/defaults/spool.cf.ja new file mode 100644 index 00000000..92f744fa --- /dev/null +++ b/fml/etc/defaults/spool.cf.ja @@ -0,0 +1,10 @@ + +=head2 すぷーる + +sequence_file = $ml_home_dir/seq + +use_spool = yes + +spool_dir = $ml_home_dir/spool + +spool_type = plane diff --git a/fml/etc/main.cf b/fml/etc/main.cf new file mode 100644 index 00000000..fc2961ec --- /dev/null +++ b/fml/etc/main.cf @@ -0,0 +1,25 @@ +version = 5.000 + +config_dir = /etc/fml + +prefix_dir = /usr/local + +libexec_dir = $prefix_dir/libexec/fml/$version + +lib_dir = $prefix_dir/lib/fml/$version/3RDPARTY + $prefix_dir/lib/fml/$version/fml5 + $prefix_dir/lib/fml/$version/CPAN + $prefix_dir/lib/fml/$version + +# site local +local_lib_dir = $prefix_dir/lib/fml/site_local + + +# default_config.cf +default_config = $config_dir/defaults/$version/default_config.cf + +# default domain +default_domain = fml.org + +# domain specific configurations +domain_default_config = $config_dir/domains/__domain__/config.cf diff --git a/fml/index.ja.html b/fml/index.ja.html new file mode 100644 index 00000000..b42a823f --- /dev/null +++ b/fml/index.ja.html @@ -0,0 +1,21 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +fml 5 project home page +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<FRAMESET COLS="25%,*" BORDERSPACING=0 FRAMEBORDER=0 BODER=0 BORDERCOLOR="#E6E6FA"> + <FRAME SRC="doc/menubar.ja.html" NAME="left"> + <FRAME SRC="doc/objects.ja.html" NAME="right"> + <NOFRAMES> + <A HREF="doc/index.ja.html"> + fml5 project doc/ + </A> + (if your browser not support frameset). + </NOFRAMES> +</FRAMESET> +</HTML> diff --git a/fml/lib/FML/.listup b/fml/lib/FML/.listup new file mode 100755 index 00000000..c36f01a0 --- /dev/null +++ b/fml/lib/FML/.listup @@ -0,0 +1,6 @@ +#!/bin/sh + +find . |\ +grep pm |\ +sed 's@./@@' |\ +awk '{print "<LI><A HREF=" $0 ">FML::" $0 "</A>"}' diff --git a/fml/lib/FML/@template b/fml/lib/FML/@template new file mode 100644 index 00000000..81d97312 --- /dev/null +++ b/fml/lib/FML/@template @@ -0,0 +1,4 @@ +# Descriptions: +# Arguments: $self $args +# Side Effects: +# Return Value: none diff --git a/fml/lib/FML/Article.pm b/fml/lib/FML/Article.pm new file mode 100644 index 00000000..aa241e91 --- /dev/null +++ b/fml/lib/FML/Article.pm @@ -0,0 +1,174 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::Article; + +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK); +use Carp; +require Exporter; + + +# Descriptions: constructor +# Arguments: $self $curproc +# Side Effects: none +# Return Value: FML::Article object +sub new +{ + my ($self, $curproc) = @_; + my ($type) = ref($self) || $self; + my $me = {}; + bless $me, $type; + + $me->_setup_article_template($curproc); + $me->{ curproc } = $curproc; + + return $me; +} + + +# Descriptions: prepare article template to distribute +# Arguments: $self $curproc +# Side Effects: build $curproc->{ article } +# Return Value: none +sub _setup_article_template +{ + my ($self, $curproc) = @_; + + # setup article to distribute + my $msg = $curproc->{'incoming_mail'}; + + # create an article template by duplicating the incoming message + $curproc->{ article }->{ header } = $msg->{'header'}->dup(); + $curproc->{ article }->{ body } = $msg->{'body'}; + + use FML::Log qw(Log); + Log( ref( $curproc->{ article }->{ header } ) ); + + # initialize the header object + use FML::Header; + $curproc->{'article'}->{'header'}->check; + $curproc->{'article'}->{'header'}->rewrite; +} + + +# Descriptions: determine article id (sequence number) +# Arguments: $self +# Side Effects: record the current article sequence number +# Return Value: number (sequence identifier) +sub gen_article_id +{ + my ($self) = @_; + my $curproc = $self->{ curproc }; + my $config = $curproc->{ config }; + my $seq_file = $config->{ sequence_file }; + my $id = 0; + + use IO::File::Atomic; + my ($rh, $wh) = IO::File::Atomic->rw_open($seq_file); + + # read the current sequence number + if (defined $rh) { + $id = $rh->getline; + $rh->close; + } + + # increment $id. The incremented number is the current article ID. + $id++; + + # save $id + print $wh $id, "\n"; + $wh->close; + + # return value + $curproc->{ pcb }->{ article_id } = $id; + $id; +} + + +sub id +{ + my ($self) = @_; + my $curproc = $self->{ curproc }; + return $curproc->{ pcb }->{ article_id }; +} + + +# Descriptions: spool in the article +# Arguments: $self $curproc +# Side Effects: +# Return Value: none +sub spool_in +{ + my ($self, $id) = @_; + + # configurations + my $curproc = $self->{ curproc }; + my $config = $curproc->{ config }; + my $spool_dir = $config->{ spool_dir }; + + print "yes: ", $config->yes( 'use_spool' ) , "\n"; + + if ( $config->yes( 'use_spool' ) ) { + unless (-d $spool_dir) { + use File::Path; + mkpath( $spool_dir, 0, 0700 ); + } + + my $file = $spool_dir . "/" . $id; + use FileHandle; + my $fh = new FileHandle; + $fh->open($file, "w"); + if (defined $fh) { + $curproc->{ article }->{ header }->print($fh); + print $fh "\n"; + print $fh ${ $curproc->{ article }->{ body } }; + $fh->close; + } + } + else { + Log("not spool"); + } +} + + + +=head1 NAME + +FML::Article - article manipulation components + +=head1 SYNOPSIS + +... not yet documented ... + +=head1 DESCRIPTION + +... not yet documented ... + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2001 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +FML::Article.pm appeared in fml5. + +=cut + + + +1; diff --git a/fml/lib/FML/Auth/Confirm.pm b/fml/lib/FML/Auth/Confirm.pm new file mode 100644 index 00000000..c5e9e29d --- /dev/null +++ b/fml/lib/FML/Auth/Confirm.pm @@ -0,0 +1,31 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::__HERE_IS_YOUR_MODULE_NAME__; + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + +=head1 DESCRIPTION + +=head1 SYNOPSIS + +=head1 AUTHOR + +=head1 HISTORY + +=cut + +use strict; +use Carp; + + +1; diff --git a/fml/lib/FML/Auth/MailFromAuth.pm b/fml/lib/FML/Auth/MailFromAuth.pm new file mode 100644 index 00000000..c5e9e29d --- /dev/null +++ b/fml/lib/FML/Auth/MailFromAuth.pm @@ -0,0 +1,31 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::__HERE_IS_YOUR_MODULE_NAME__; + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + +=head1 DESCRIPTION + +=head1 SYNOPSIS + +=head1 AUTHOR + +=head1 HISTORY + +=cut + +use strict; +use Carp; + + +1; diff --git a/fml/lib/FML/Auth/Moderate.pm b/fml/lib/FML/Auth/Moderate.pm new file mode 100644 index 00000000..c5e9e29d --- /dev/null +++ b/fml/lib/FML/Auth/Moderate.pm @@ -0,0 +1,31 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::__HERE_IS_YOUR_MODULE_NAME__; + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + +=head1 DESCRIPTION + +=head1 SYNOPSIS + +=head1 AUTHOR + +=head1 HISTORY + +=cut + +use strict; +use Carp; + + +1; diff --git a/fml/lib/FML/Auth/PGPAuth.pm b/fml/lib/FML/Auth/PGPAuth.pm new file mode 100644 index 00000000..c5e9e29d --- /dev/null +++ b/fml/lib/FML/Auth/PGPAuth.pm @@ -0,0 +1,31 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::__HERE_IS_YOUR_MODULE_NAME__; + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + +=head1 DESCRIPTION + +=head1 SYNOPSIS + +=head1 AUTHOR + +=head1 HISTORY + +=cut + +use strict; +use Carp; + + +1; diff --git a/fml/lib/FML/Body.pm b/fml/lib/FML/Body.pm new file mode 100644 index 00000000..74bd5893 --- /dev/null +++ b/fml/lib/FML/Body.pm @@ -0,0 +1,81 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::Body; + +=head1 NAME + +FML::Body - mail body manipulators + +=head1 SYNOPSIS + +... not yet documentd ... + +=head1 DESCRIPTION + +... not yet documentd ... + +... not yet documentd ... + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2001 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +FML::Body.pm appeared in fml5. + +=cut + +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK); +use Carp; +require Exporter; +@ISA = qw(Exporter); + + +sub new +{ + my ($self, $r_body) = @_; + my ($type) = ref($self) || $self; + return bless $r_body, $type; +} + + +sub size +{ + my ($self) = @_; + length($self); +} + + +sub is_empty +{ + my ($self) = @_; + my $size = $self->size; + + if ($size == 0) { return 1;} + if ($size <= 8) { + if ($self =~ /^\s*$/) { return 1;} + } + + # false + return 0; +} + + +1; diff --git a/fml/lib/FML/CGI/Functions.pm b/fml/lib/FML/CGI/Functions.pm new file mode 100644 index 00000000..c5e9e29d --- /dev/null +++ b/fml/lib/FML/CGI/Functions.pm @@ -0,0 +1,31 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::__HERE_IS_YOUR_MODULE_NAME__; + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + +=head1 DESCRIPTION + +=head1 SYNOPSIS + +=head1 AUTHOR + +=head1 HISTORY + +=cut + +use strict; +use Carp; + + +1; diff --git a/fml/lib/FML/Config.pm b/fml/lib/FML/Config.pm new file mode 100644 index 00000000..14cf4114 --- /dev/null +++ b/fml/lib/FML/Config.pm @@ -0,0 +1,275 @@ +#-*- perl -*- +# Copyright (C) 2000 Ken'ichi Fukamachi +# +# $Id$ +# $FML$ # 注意: cvs のタグを $FML$ にする +# + +package FML::Config; + +use vars qw(%_fml_config); +use strict; +use Carp; + + +sub new +{ + my ($self) = @_; + my $me = \%_fml_config; + return bless $me, $self; +} + + +sub dump_variables +{ + my ($k, $v); + while (($k, $v) = each %_fml_config) { + print "${k}: $v\n"; + } +} + + +sub _log +{ + my ($self, $msg) = @_; + $self->{ _error_message } = $msg; +} + + +sub error +{ + my ($self) = @_; + $self->{ _error_message }; +} + + +sub get +{ + my ($self, $key) = @_; + $self->{ $key }; +} + + +sub set +{ + my ($self, $key, $value) = @_; + $self->{ $key } = $value; +} + + +sub overload +{ + my ($self, $file) = @_; + $self->load_file($file); +} + + +sub load_file +{ + my ($self, $file) = @_; + my (@_fml_config) = (); + + # open the $file by using FileHandle.pm + use FileHandle; + my $fh = new FileHandle $file; + + if (defined $fh) { + my ($key, $value, $comment); + + while (<$fh>) { + # end of postfix format + last if /^=cut/; + + # here we go + chop; + + # reset { key => value } + if (/^\s*$/) { + if ($key) { + $_fml_config{$key} = $value; + } + + undef $key; undef $value; undef $comment; + } + + # ignore special keywords of pod formats + next if /^=/; + + if (/^([A-Za-z]\w+)\s+=\s*(.*)/) { + ($key, $value) = ($1, $2); + + # record the keyword order + push(@_fml_config, $key); + } + elsif (/^\s+(.*)/ && $key) { + $value .= " ".$1; + } + else { + $comment .= $_; + } + } + $fh->close; + } + else { + $self->_log("Error: cannot open $file"); + } + + # expand variable name e.g. $dir/xxx -> /var/spool/ml/elena/xxx + _expand_variables( \%_fml_config , \@_fml_config ); +} + + +sub _expand_variables +{ + my ($config, $order) = @_; + my $max = 0; + my $org = ''; + + # expand $xxx style variables + no strict 'refs'; + for my $x ( @$order ) { $$x = $config->{ $x };} + + KEY: + for my $x ( @$order ) { + next KEY unless $config->{ $x } =~ /\$/o; + + $max = 0; + + # we need a loop to expand nested variables, for example, + # a = $x/y and b = $a/c/0 + EXPAND_LOOP: + while ($max++ < 16) { + $org = $config->{ $x }; + $config->{ $x } =~ s/\$([a-z_]+)/${$1}/g; + last EXPAND_LOOP if $org eq $config->{ $x }; + } + } +} + + +sub yes +{ + my ($self, $key) = @_; + $_fml_config{$key} eq 'yes' ? 1 : 0; +} + + +sub no +{ + my ($self, $key) = @_; + $_fml_config{$key} eq 'no' ? 1 : 0; +} + + +sub FETCH +{ + my ($self, $key) = @_; + return $_fml_config{$key}; +} + + +sub STORE +{ + my ($self, $key, $value) = @_; + $_fml_config{$key} = $value; +} + + +sub DELETE +{ + my ($self, $key) = @_; + delete $_fml_config{$key}; +} + + +sub CLEAR +{ + my ($self) = @_; + undef %_fml_config; +} + + +=head1 NAME + +FML::Config -- fml5 configuration holding object + +=head1 SYNOPSIS + + $config = new FML::Config; + + # get the current value + $config->{recipient_maps}; + + # set the new value + $config->{recipient_maps} = 'mysql:toymodel'; + + # function style to get/set the value for the key "recipient_maps" + $config->get('recipient_maps'); + $config->set('recipient_maps', 'mysql:toymodel'); + + +=head1 DESCRIPTION + + +=head1 METHOD + +=item Init( ref_to_curproc ) + +special method only used in the initialization phase. +This method binds $curproc and the %_fml_config memory area. + +=item load_file( filename ) + +read the configuration file, split key and value and set them to +%_fml_config. + +=item get( key ) + +=item set( key, value ) + +=item dump_variables() + +show all {key => value} for debug. + +=head1 DATA STRUCTURE + +C<%CurProc> holds the CURrent PROCess information. +The hash holds several references to other data structures, +which are mainly hashes. + + $CurProc = { + # configurations + config => { + key => value, + }, + + # emulator mode though fml mode in fact + emulator => $emulator, + + # struct incoming_mail holds the mail input from STDIN. + incoming_mail => $r_msg, + article => $r_msg, + }; + +We use r_variable_name syntax where "r_" implies "reference to" here. +C<$r_msg> is the reference to "struct message". + + $r_msg = { + r_header => \$header, + r_body => \$body, + info => { + mime-version => 1.0, + content-type => { + charset => ISO-2022-JP, + }, + size => $size, + }, + }; + +where $header is the object returned by Mail::Header class (CPAN +module) and the $body is the reference to the mail body region on +memory which locates within FML::Parse name space. + +=cut + +1; diff --git a/fml/lib/FML/Credential.pm b/fml/lib/FML/Credential.pm new file mode 100644 index 00000000..74a6bf99 --- /dev/null +++ b/fml/lib/FML/Credential.pm @@ -0,0 +1,82 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::Credential; + +use strict; +use vars qw(%Credential @ISA @EXPORT @EXPORT_OK); +use Carp; + +require Exporter; +@ISA = qw(Exporter); + + +sub new +{ + my ($self) = @_; + my ($type) = ref($self) || $self; + my $me = \%Credential; + return bless $me, $type; +} + + +sub is_member +{ + 1; +} + + +sub get +{ + my ($self, $key) = @_; + $self->{ $key }; +} + + +sub set +{ + my ($self, $key, $value) = @_; + $self->{ $key } = $value; +} + + +=head1 NAME + +FML::Credential.pm - what is this + + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 new + +=item Function() + + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2001 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +FML::Credential.pm appeared in fml5. + +=cut + + +1; diff --git a/fml/lib/FML/Date.pm b/fml/lib/FML/Date.pm new file mode 100644 index 00000000..028d02fe --- /dev/null +++ b/fml/lib/FML/Date.pm @@ -0,0 +1,149 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# +# $Id$ +# $FML$ +# + +package FML::Date; + +=head1 NAME + +FML::Date - utilities for date and time + +=head1 SYNOPSIS + + + use FML::Date; + $date = new FML::Date time; + + # get the date in $style format + $date->{ logfile_style } + $date->logfile_style + +=head1 DESCRIPTION + +The style you use follows: + + style example + ---------------------------------------------- + logfile_style 01/01/07 21:06:19 + mail_header_style Sun, 7 Jan 2001 21:06:19 +0900 + YYYYMMDD 20010107 + current_time 200101072106 + precise_current_time 20010107210619 + + +=head1 METHOD + +You can also method like $date->$style() style. + +=item logfile_style() + +=item mail_header_style() + +=item YYYYMMDD() + +=item current_time() + +=item precise_current_time() + +=cut + +require Exporter; +use vars qw($TimeZone); +@ISA = qw(Exporter); + +use strict; +use Carp; + + +sub new +{ + my ($class, $time) = @_; + my $type = _date($time); + return bless $type, $class; +} + + +sub _date +{ + my ($time) = @_; + my ($date) = {}; + + # use the current UTC if $time is not given. + $time ||= time; + + my @WDay = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); + my @Month = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', + 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); + + $TimeZone ||= '+0900'; + my ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime($time))[0..6]; + + $date->{'logfile_style'} = + sprintf("%02d/%02d/%02d %02d:%02d:%02d", + ($year % 100), $mon + 1, $mday, $hour, $min, $sec); + + $date->{'mail_header_style'} = + sprintf("%s, %d %s %d %02d:%02d:%02d %s", + $WDay[$wday], $mday, $Month[$mon], + 1900 + $year, $hour, $min, $sec, $TimeZone); + + $date->{'YYYYMMDD'} = + sprintf("%04d%02d%02d", 1900 + $year, $mon + 1, $mday); + + $date->{'current_time'} = + sprintf("%04d%02d%02d%02d%02d", + 1900 + $year, $mon + 1, $mday, $hour, $min); + + $date->{'precise_current_time'} = + sprintf("%04d%02d%02d%02d%02d%02d", + 1900 + $year, $mon + 1, $mday, $hour, $min, $sec); + + return $date; +} + + +sub logfile_style +{ + my ($self, $time) = @_; + my $p = _date($time || time); + $p->{'logfile_style'}; +} + + +sub mail_header_style +{ + my ($self, $time) = @_; + my $p = _date($time || time); + $p->{'mail_header_style'}; +} + + +sub YYYYMMDD +{ + my ($self, $time) = @_; + my $p = _date($time || time); + $p->{'YYYYMMDD'}; +} + + +sub current_time +{ + my ($self, $time) = @_; + my $p = _date($time || time); + $p->{'current_time'}; +} + + +sub precise_current_time +{ + my ($self, $time) = @_; + my $p = _date($time || time); + $p->{'precise_current_time'}; +} + + +1; diff --git a/fml/lib/FML/Debug.pm b/fml/lib/FML/Debug.pm new file mode 100644 index 00000000..1d17c3a5 --- /dev/null +++ b/fml/lib/FML/Debug.pm @@ -0,0 +1,46 @@ +#-*- perl -*- +# +# Copyright (C) 2000-2001 Ken'ichi Fukamachi +# All rights reserved. +# +# $FML$ +# + +package FML::Debug; + +=head1 NAME + +FML::Debug -- debug utilities + +=head1 SYNOPSIS + + use FML::Debug; + FML::Debug->show_structure( $variable ); + +=head1 METHOD + +=item show_structure() + +It shows the data structure for the given variable. + +=cut + + +sub new +{ + my ($self) = @_; + my ($type) = ref($self) || $self; + my $me = {}; + bless $me, $self, +} + + +sub show_structure +{ + my ($class, $ref) = @_; + use Data::Dumper; + print Dumper( $ref ); +} + + +1; diff --git a/fml/lib/FML/Encrypt/Crypt.pm b/fml/lib/FML/Encrypt/Crypt.pm new file mode 100644 index 00000000..c5e9e29d --- /dev/null +++ b/fml/lib/FML/Encrypt/Crypt.pm @@ -0,0 +1,31 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::__HERE_IS_YOUR_MODULE_NAME__; + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + +=head1 DESCRIPTION + +=head1 SYNOPSIS + +=head1 AUTHOR + +=head1 HISTORY + +=cut + +use strict; +use Carp; + + +1; diff --git a/fml/lib/FML/Encrypt/GPG1.pm b/fml/lib/FML/Encrypt/GPG1.pm new file mode 100644 index 00000000..c5e9e29d --- /dev/null +++ b/fml/lib/FML/Encrypt/GPG1.pm @@ -0,0 +1,31 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::__HERE_IS_YOUR_MODULE_NAME__; + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + +=head1 DESCRIPTION + +=head1 SYNOPSIS + +=head1 AUTHOR + +=head1 HISTORY + +=cut + +use strict; +use Carp; + + +1; diff --git a/fml/lib/FML/Encrypt/PGP2.pm b/fml/lib/FML/Encrypt/PGP2.pm new file mode 100644 index 00000000..c5e9e29d --- /dev/null +++ b/fml/lib/FML/Encrypt/PGP2.pm @@ -0,0 +1,31 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::__HERE_IS_YOUR_MODULE_NAME__; + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + +=head1 DESCRIPTION + +=head1 SYNOPSIS + +=head1 AUTHOR + +=head1 HISTORY + +=cut + +use strict; +use Carp; + + +1; diff --git a/fml/lib/FML/Encrypt/PGP5.pm b/fml/lib/FML/Encrypt/PGP5.pm new file mode 100644 index 00000000..c5e9e29d --- /dev/null +++ b/fml/lib/FML/Encrypt/PGP5.pm @@ -0,0 +1,31 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::__HERE_IS_YOUR_MODULE_NAME__; + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + +=head1 DESCRIPTION + +=head1 SYNOPSIS + +=head1 AUTHOR + +=head1 HISTORY + +=cut + +use strict; +use Carp; + + +1; diff --git a/fml/lib/FML/Header.pm b/fml/lib/FML/Header.pm new file mode 100644 index 00000000..37875a87 --- /dev/null +++ b/fml/lib/FML/Header.pm @@ -0,0 +1,91 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::Header; + +=head1 NAME + +FML::Header - header manipulators + +=head1 SYNOPSIS + + $header = use FML::Header $r_header; + $header->rewrite; + +(... not yet mature ...) + + +=head1 DESCRIPTION + +=head1 METHOD + +=item rewrite + +=item check + + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2001 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +FML::Header.pm appeared in fml5. + +=cut + +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); +use Carp; +use Mail::Header; +use FML::Log qw(Log); + +require Exporter; +@ISA = qw(Exporter Mail::Header); + + +sub new +{ + my ($self, $args) = @_; + $self->SUPER::new($args); +} + +sub DESTROY {} + +sub AUTOLOAD +{ + my ($self, $args) = @_; + Log("Error: $AUTOLOAD is not defined"); +} + + +sub rewrite +{ + my ($self) = @_; +} + + +sub check +{ + my ($self) = @_; + + print "From: ", $self->get('from'); + print "Message-Id: ", $self->get('message-id'); +} + + +1; diff --git a/fml/lib/FML/Lock.pm b/fml/lib/FML/Lock.pm new file mode 100644 index 00000000..f627c4c4 --- /dev/null +++ b/fml/lib/FML/Lock.pm @@ -0,0 +1,174 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# +# $Id$ +# $FML$ +# + +package FML::Lock; + +use vars qw(%LockedFileHandle %FileIsLocked @ISA $Error); +use strict; +use Carp; + +require Exporter; +@ISA = qw(Exporter); + + +# constants +use POSIX qw(EAGAIN ENOENT EEXIST O_EXCL O_CREAT O_RDONLY O_WRONLY); +sub LOCK_SH {1;} +sub LOCK_EX {2;} +sub LOCK_NB {4;} +sub LOCK_UN {8;} + + +sub new +{ + my ($self) = @_; + my ($type) = ref($self) || $self; + my $me = {}; + return bless $me, $type; +} + + +sub _error_why +{ + my $msg = @_; + $Error = $msg; +} + + +sub error +{ + my ($self) = @_; + $Error; +} + + +sub lock +{ + my ($self, $args) = @_; + + my $file = $args->{ file }; + _simple_flock($file); +} + + +sub unlock +{ + my ($self, $args) = @_; + + my $file = $args->{ file }; + _simple_funlock($file); +} + + + +sub _simple_flock +{ + my ($file) = @_; + + use FileHandle; + my $fh = new FileHandle $file; + + if (defined $fh) { + $LockedFileHandle{ $file } = $fh; + + my $r = 0; # return value + eval q{ + $r = flock($fh, &LOCK_EX); + }; + _error_why($@) if $@; + + if ($r) { + $FileIsLocked{ $file } = 1; + return 1; + } + } + else { + _error_why("cannot open $file"); + } + + return 0; +} + + +sub _simple_funlock +{ + my ($file) = @_; + + return 0 unless $FileIsLocked{ $file }; + return 0 unless $LockedFileHandle{ $file }; + + my $fh = $LockedFileHandle{ $file }; + + my $r = 0; # return value + eval q{ + $r = flock($fh, &LOCK_UN); + }; + _error_why($@) if $@; + + if ($r) { + delete $FileIsLocked{ $file }; + delete $LockedFileHandle{ $file }; + return 1; + } + + return 0; +} + + +=head1 NAME + +FML::Lock.pm - several interfaces to open several files + + +=head1 SYNOPSIS + +To import Lock(), + + use FML::Lock qw(Lock); + &Lock( $Lock_message ); + + +=head1 DESCRIPTION + +FML::Lock.pm contains several interfaces for several files, +for example, Lockfiles, sysLock() (not yet implemented). + +=item Lock( $message ) + +The argument is the message to Lock. + + + +=head1 SEE ALSO + +L<FML::Date>, +L<FML::Config>, +L<FML::BaseSystem>, +L<FileHandle> + +=head1 AUTHOR + +Ken'ichi Fukamachi <F<fukachan@fml.org>> + + +=head1 COPYRIGHT + +Copyright (C) 2000 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + + +=head1 HISTORY + +FML::Lock.pm appeared in fml5. + + +=cut + +1; diff --git a/fml/lib/FML/Log.pm b/fml/lib/FML/Log.pm new file mode 100644 index 00000000..b6e805a2 --- /dev/null +++ b/fml/lib/FML/Log.pm @@ -0,0 +1,118 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# +# $Id$ +# $FML$ +# + +package FML::Log; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(Log); +@EXPORT_OK = qw(Log); + +use strict; +use Carp; +use FML::Config; +use FML::Date; + + +# usage: &Log( message, { logfile => $logfile } ); +# return: none +# +sub Log +{ + my ($mesg, $args) = @_; + my $config = new FML::Config; + + # parse arguments + my $logfile = $args->{ logfile }; + my $facility = $args->{ facility }; + my $level = $args->{ level }; + + # invalid calling + $mesg || return undef ; + + # reference to "date" object + my $rdate = new FML::Date; + + # open the $file by using FileHandle.pm + use FileHandle; + + # When the second argument is not defined, use the default logfile. + my $file = $logfile || $config->{ logfile } || '/dev/stderr'; + my $fh = new FileHandle ">> $file"; + + if (defined $fh) { + print $fh $rdate->{'logfile_style'}, " ", $mesg, "\n"; + } + else { + croak "Error: cannot open $file\n"; + } +} + + + +=head1 NAME + +FML::Log.pm - several interfaces to open several files + + +=head1 SYNOPSIS + +To import Log(), + + use FML::Log qw(Log); + &Log( $log_message ); + +or specify arguments in the hash reference + + use FML::Log qw(Log); + &Log( $log_message , { + logfile => $logfile, + facility => $facility, + level => $level, + }); + + +=head1 DESCRIPTION + +FML::Log.pm contains several interfaces for several files, +for example, logfiles, syslog() (not yet implemented). + +=item Log( $message ) + +The argument is the message to log. + + + +=head1 SEE ALSO + +L<FML::Date>, +L<FML::Config>, +L<FML::BaseSystem>, +L<FileHandle> + +=head1 AUTHOR + +Ken'ichi Fukamachi <F<fukachan@fml.org>> + + +=head1 COPYRIGHT + +Copyright (C) 2000 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + + +=head1 HISTORY + +FML::Log.pm appeared in fml5. + + +=cut + +1; diff --git a/fml/lib/FML/Makefile b/fml/lib/FML/Makefile new file mode 100644 index 00000000..08cebdec --- /dev/null +++ b/fml/lib/FML/Makefile @@ -0,0 +1,4 @@ +all: anal + +anal: + @ find . | sort | grep -v CVS | sed 's@./@@' diff --git a/fml/lib/FML/Messages.pm b/fml/lib/FML/Messages.pm new file mode 100644 index 00000000..4ad94412 --- /dev/null +++ b/fml/lib/FML/Messages.pm @@ -0,0 +1,60 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::Messages; +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK); +use Carp; +require Exporter; + + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 new + +=item Function() + + +=head1 AUTHOR + +=head1 COPYRIGHT + +Copyright (C) 2001 __YOUR_NAME__ + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +FML::__MODULE_NAME__.pm appeared in fml5. + +=cut + + +@ISA = qw(Exporter); +@EXPORT_OK = qw(Log); + + +sub new +{ + my ($self) = @_; + my ($type) = ref($self) || $self; + return bless {}, $type; +} + + +1; diff --git a/fml/lib/FML/Parse.pm b/fml/lib/FML/Parse.pm new file mode 100644 index 00000000..c57bd028 --- /dev/null +++ b/fml/lib/FML/Parse.pm @@ -0,0 +1,126 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::Parse; + + +=head1 NAME + +FML::Parse - parse the incoming message/mail to the header and body. + +=head1 SYNOPSIS + + ($r_header, $r_body) = new FML::Parse \*STDIN; + +=head1 DESCRIPTION + +FML::Parse parses the incoming mail. The target to parse is given the +argument os new() constructor. + +$r_header is the reference to the header object, which is returned by +Mail::Header class. $r_body is reference to the scalar mail body +variable, which is alloced in FML::Parse name space. + +=head1 METHOD + +=item new( fd ) + +C<fd> is the file handle. +Normally C<fd> is the handle for STDIN channel. + +=head1 SEE ALSO + +L<Mail::Header>, + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2001 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +FML::Parse.pm appeared in fml5. + +=cut + + +use lib qw(./lib/fml5 ./lib/CPAN ./lib/3RDPARTY ./lib); +use vars qw($InComingMessage); +use strict; +use Carp; +use FML::Header; +use FML::Body; +use FML::Config; +use FML::Log qw(Log); + + +sub new +{ + my ($self, $fd) = @_; + my $me = {}; + bless $me, $self; + + # return ( $ref_to_mail_header, $ref_to_mail_body, $error_code); + return $me->_parse($fd); +} + + +# return ( $ref_to_mail_header, $ref_to_mail_body, $error_code); +sub _parse +{ + my ($self, $fd) = @_; + my ($header, $header_size); + my $body_size; + my $total_buffer_size; + my ($p, $buf); + + # extract header and put it to $header + while ($p = sysread($fd, $_, 1024)) { + $total_buffer_size += $p; + $buf .= $_; + if (($p = index($buf, "\n\n", 0)) > 0) { + $header = substr($buf, 0, $p + 1); + $header_size = $p + 1; + $InComingMessage = substr($buf, $p + 2); + last; + } + } + + # extract mail body and put it to $FML::Parse::InComingMessage + while ($p = sysread($fd, $_, 1024)) { + $total_buffer_size += $p; + $InComingMessage .= $_; + } + + # read the message (mail body) from the incoming mail + $body_size = length($InComingMessage); + + Log("read total=$total_buffer_size header=$header_size body=$body_size"); + + my @h = split(/\n/, $header); + my $x; + for $x (@h) { $x .= "\n";} + + # extract each field from the header array + my $r_header = new FML::Header \@h, Modify => 0; + my $r_body = new FML::Body \$InComingMessage; + + # return ( $ref_to_mail_header, $ref_to_mail_body, $error_code); + return ($r_header, $r_body, 0); +} + + +1; diff --git a/fml/lib/FML/Process/Distribute.pm b/fml/lib/FML/Process/Distribute.pm new file mode 100644 index 00000000..397ce453 --- /dev/null +++ b/fml/lib/FML/Process/Distribute.pm @@ -0,0 +1,173 @@ +#!/usr/local/bin/perl -w +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. +# +# $FML$ +# + +package FML::Process::Distribute; + +use vars qw($debug @ISA @EXPORT @EXPORT_OK); +use strict; +use Carp; + +use FML::Process::Kernel; +use FML::Log qw(Log); +use FML::Config; + +require Exporter; +@ISA = qw(FML::Process::Kernel Exporter); + + +sub new +{ + my ($self, $args) = @_; + my $type = ref($self) || $self; + my $curproc = new FML::Process::Kernel $args; + return bless $curproc, $type; +} + + +sub prepare +{ + my ($self, $args) = @_; + $self->SUPER::prepare($args); +} + + +sub run +{ + my ($curproc, $args) = @_; + + $curproc->verify_sender_credential(); + + $curproc->lock(); + { + # user credential + my $cred = $curproc->{ credential }; + + # Q: the mail sender is a ML member? + if ($cred->is_member) { + # A: If so, we try to distribute this article. + _distribute( $curproc ); + } + } + $curproc->unlock(); +} + + +sub finish +{ + my ($curproc, $args) = @_; + + $curproc->inform_reply_messages(); +} + + +# $article->header_rewrite; +# $article->increment_id; +# $article->spool; +# distribute( $article ); +sub _distribute +{ + my ($curproc, $args) = @_; + + # use FML::Debug; FML::Debug->show_structure( $curproc ); # XXX DEBUG + + # create aritcle to distribute + use FML::Article; + my $article = new FML::Article $curproc; + + # spool in + my $id = $article->gen_article_id; + $article->spool_in( $id ); + + # distribute article + use Netlib::SMTP; + my $fp = sub { Log(@_);}; # pointer to the log function + my $service = new Netlib::SMTP { + log_function => $fp, + socket_timeout => 2, + }; + if ($service->error) { Log($service->error); return;} + + my $fileobj; + my $body = $curproc->{'article'}->{'body'}; + my $header = $curproc->{'article'}->{'header'}; + my $config = $curproc->{'config'}; + + my $ra_rcpt = [ + 'fukachan-1@elena.sapporo.iij.ad.jp', + 'fukachan-2@elena.sapporo.iij.ad.jp', + 'fukachan-3@elena.sapporo.iij.ad.jp', + 'fukachan-4@elena.sapporo.iij.ad.jp', + 'fukachan-5@elena.sapporo.iij.ad.jp', + ]; + + undef $ra_rcpt; + $ra_rcpt = [ 'fukachan@nuinui.net' ]; + + $service->deliver( + { + 'mta' => $config->{'mta'}, + + 'smtp_sender' => 'rudo', + 'recipient_array' => $ra_rcpt, + 'recipient_maps' => $config->{recipient_maps}, + 'recipient_limit' => $config->{recipient_limit}, + + 'header' => $header, + 'body' => $body, + }); + if ($service->error) { Log($service->error); return;} +} + + + +=head1 NAME + +distribute -- fml5 article distributer program. + +=head1 SYNOPSIS + + distribute [-d] config.cf + +=head1 DESCRIPTION + +libexec/fml.pl, the wrapper, executes this program. For example, The +incoming mail to elena@fml.org kicks off libexec/distribute via +libexec/fml.pl, whereas mail to elena-ctl@fml.org kicks off +libexec/command finally. + + incoming_mail => + elena@fml.org => fml.pl => libexec/distribute + elena-ctl@fml.org => fml.pl => libexec/command + elena-admin@fml.org => forwarded to administrator(s) + OR + => libexec/mead + +C<-d> + debug on. + +=head1 FLOW AROUND COMPONENTS + + | <=> FML::BaseSystem + | load configuration files + | start logging service + | + | STDIN => FML::Parse + | $CurProc->{'incoming_mail'} <= + | $CurProc->{'credential'} + | + | (lock) + | prepare article + | $CurProc->{'article'} is spooled in. + | $CurProc->{'article'} <=> Service::SMTP + | (unlock) + V + +=cut + +1; diff --git a/fml/lib/FML/Process/Kernel.pm b/fml/lib/FML/Process/Kernel.pm new file mode 100644 index 00000000..ce692a7f --- /dev/null +++ b/fml/lib/FML/Process/Kernel.pm @@ -0,0 +1,197 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::Process::Kernel; + +use strict; +use Carp; +use FML::Parse; +use FML::Header; +use FML::Config; +use FML::Log qw(Log); +use FML::Lock; +use FML::Messages; + + +sub new +{ + my ($self, $args) = @_; + my ($curproc) = {}; # alloc memory as the struct current_process. + + # bind FML::Config object to $curproc + use FML::Config; + $curproc->{ config } = new FML::Config; + + bless $curproc, $self; + + # initialize + my $main_config = $args->{ main_config }; + my $ra_cf = $args->{ cf_list }; + $curproc->load_config_files( $ra_cf ); + + return $curproc; +} + + +sub prepare +{ + my ($curproc, $args) = @_; + $curproc->parse_incoming_mail(); +} + + +sub lock +{ + my ($curproc, $args) = @_; + + # lock information + my $config = $curproc->{ config }; + my $lock_dir = $config->{ lock_dir }; + my $lock_file = $config->{ lock_file }; + my $lock_type = $config->{ lock_type }; + + unless (-d $lock_dir) { + use File::Path; + mkpath($lock_dir, 0, 0755); + } + + unless (-f $lock_file) { + use FileHandle; + my $fh = new FileHandle $lock_file, "a"; + if (defined $fh) { + print $fh "\n"; + $fh->close if $fh; + } + } + + require FML::Lock; + my $lockobj = new FML::Lock; + + return 0 unless $lock_file ; + my $r = $lockobj->lock( { file => $lock_file } ); + if ($r) { + $curproc->{ pcb }->{ lock }->{ object } = $lockobj; + $curproc->{ pcb }->{ lock }->{ file } = $lock_file; + Log( "locked $lock_file"); + } + else { + croak("Error: cannot lock"); + } +} + + +sub unlock +{ + my ($curproc, $args) = @_; + + my $lockobj = $curproc->{ pcb }->{ lock }->{ object }; + my $lock_file = $curproc->{ pcb }->{ lock }->{ file }; + + my $r = $lockobj->unlock( { file => $lock_file } ); + if ($r) { + Log( "unlocked $lock_file"); + } + else { + croak("Error: cannot lock"); + } +} + + +sub inform_reply_messages +{ + my ($curproc, $args) = @_; +} + + +sub ValidateInComingMail +{ + my ($curproc, $args) = @_; +} + + +sub verify_sender_credential +{ + my ($curproc, $args) = @_; + my $r_msg = $curproc->{'incoming_mail'}; + my $from = $r_msg->{'header'}->get('from'); + + use Mail::Address; + my @addrs = Mail::Address->parse($from); + + my $count = 0; + for my $a (@addrs) { + $count++; + + # extract the first address as a sender. + $from = $a->format unless $from; + } + + if ($count == 1) { + Log("sender: $from"); + use FML::Credential; + $curproc->{'credential'} = new FML::Credential; + $curproc->{'credential'}->set( 'sender', $from ); + } + else { + Log("invalid From:"); + } +} + + +sub sender_is_member +{ + my ($curproc, $args) = @_; + $curproc->{'credential'}->{'sender'} + # &IsMailingListMember( $from ); +} + + +# fml5::init_main() routine +sub load_config_files +{ + my ($curproc, $files) = @_; + + # load configuration variables from given files e.g. /some/where.cf + # XXX overload variables from each $cf + for my $cf (@$files) { + $curproc->{ config }->overload( $cf ); + } +} + + +sub parse_incoming_mail +{ + my ($curproc, $args) = @_; + + # parse incoming mail to cut off it to the header and the body. + use FML::Parse; + + # malloc the incoming message on memory. + # $r_msg is the reference to the memory area. + my $r_msg = {}; + ($r_msg->{'header'}, $r_msg->{'body'}) = new FML::Parse \*STDIN; + $curproc->{'incoming_mail'} = $r_msg; +} + + +# debug +sub Debug +{ + my ($curproc, $args) = @_; + + eval { + use FML::Debug; + my $fp = new FML::Debug; + $fp->show_structure($curproc); + }; +} + + +1; diff --git a/fml/lib/FML/String.pm b/fml/lib/FML/String.pm new file mode 100644 index 00000000..b1246eb3 --- /dev/null +++ b/fml/lib/FML/String.pm @@ -0,0 +1,91 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::String; + +use Carp; + +require Exporter; +@ISA = qw(Exporter); +@EXPORT_OK = qw(STR2JIS STR2EUC); + +use strict; + +sub AUTOLOAD +{ + print STDERR "bad AUTOLOAD()\n"; +} + +sub STR2EUC +{ + my ($str) = @_; + + use Jcode; + &Jcode::convert(\$str, 'euc'); +} + + +sub STR2JIS +{ + my ($str) = @_; + + use Jcode; + &Jcode::convert(\$str, 'jis'); +} + + +sub STR2SJIS +{ + my ($str) = @_; + + use Jcode; + &Jcode::convert(\$str, 'sjis'); +} + + +=head1 NAME + +FML::String -- utilties to manipulate strings + +=head1 SYNOPSIS + +=head1 METHOD + +=item STR2JIS(string) + +convert CHARSET of the given string to JIS. + +=item STR2EUC(string) + +convert CHARSET of the given string to EUC. + +=item STR2SJIS(string) + +convert CHARSET of the given string to SJIS. + + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2001 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +FML::String.pm appeared in fml5. + +=cut + +1; diff --git a/fml/lib/FML/index.ja.html b/fml/lib/FML/index.ja.html new file mode 100644 index 00000000..878296b3 --- /dev/null +++ b/fml/lib/FML/index.ja.html @@ -0,0 +1,64 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +lib/fml5/FML/ +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +lib/fml5/FML/ ディレクトリ: FML::* モジュールの置場所。 + +<UL> + <LI> + <A HREF=Article.pm>Article.pm</A> + + <LI> + <A HREF=BaseSystem.pm>BaseSystem.pm</A> + + <LI> + <A HREF=Body.pm>Body.pm</A> + + <LI> + <A HREF=Config.pm>Config.pm</A> + + <LI> + <A HREF=Date.pm>Date.pm</A> + + <LI> + <A HREF=Debug.pm>Debug.pm</A> + + <LI> + <A HREF=Header.pm>Header.pm</A> + + <LI> + <A HREF=IO/index.ja.html>IO::</A> + + <LI> + <A HREF=Lock.pm>Lock.pm</A> + + <LI> + <A HREF=Log.pm>Log.pm</A> + + <LI> + <A HREF=Messages.pm>Messages.pm</A> + + <LI> + <A HREF=Parse.pm>Parse.pm</A> + + <LI> + <A HREF=String.pm>String.pm</A> + + <LI> + <A HREF=libkern.pl>libkern.pl</A> + +</UL> + + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/lib/IO/@template b/fml/lib/IO/@template new file mode 100644 index 00000000..81d97312 --- /dev/null +++ b/fml/lib/IO/@template @@ -0,0 +1,4 @@ +# Descriptions: +# Arguments: $self $args +# Side Effects: +# Return Value: none diff --git a/fml/lib/IO/Adapter/File.pm b/fml/lib/IO/Adapter/File.pm new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/fml/lib/IO/Adapter/File.pm diff --git a/fml/lib/IO/Adapter/LDAP.pm b/fml/lib/IO/Adapter/LDAP.pm new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/fml/lib/IO/Adapter/LDAP.pm diff --git a/fml/lib/IO/Adapter/NIS.pm b/fml/lib/IO/Adapter/NIS.pm new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/fml/lib/IO/Adapter/NIS.pm diff --git a/fml/lib/IO/Adapter/RDBMS.pm b/fml/lib/IO/Adapter/RDBMS.pm new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/fml/lib/IO/Adapter/RDBMS.pm diff --git a/fml/lib/IO/Adapter/UnixGroup.pm b/fml/lib/IO/Adapter/UnixGroup.pm new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/fml/lib/IO/Adapter/UnixGroup.pm diff --git a/fml/lib/IO/File/Atomic.pm b/fml/lib/IO/File/Atomic.pm new file mode 100644 index 00000000..0efc717e --- /dev/null +++ b/fml/lib/IO/File/Atomic.pm @@ -0,0 +1,167 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package IO::File::Atomic; +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK); +use Carp; + +require Exporter; +@ISA = qw(IO::File); + + +sub BEGIN {} + + +sub new +{ + my ($class) = shift; + my $self = $class->SUPER::new(); + $self->open(@_) if @_; + $self; +} + + +sub open +{ + my ($self, $file, $mode) = @_; + + # get an instance + ref($self) or $self = $self->new; + + # default mode is "w" + $mode ||= "w"; + + # temporary file + my $temp = $file.".new.".$$; + ${*$self}{ _orig } = $file; + ${*$self}{ _temp } = $temp; + + # real open with $mode + $self->autoflush; + $self->SUPER::open($temp, "w") ? $self : undef; +} + + +sub rw_open +{ + my ($self, $file, $mode) = @_; + + use FileHandle; + my $rh = new FileHandle $file; + my $wh = $self->open($file, $mode); + + return ($rh, $wh); +} + + +sub close +{ + my ($self) = @_; + my $fh = $self; + my $orig = ${ *$fh }{ _orig }; + my $temp = ${ *$fh }{ _temp }; + + if (rename($temp, $orig)) { + ${ *$fh }{ _error } = "fail to rename($temp, $orig)"; + } + else { + undef; + } +} + + +sub error +{ + my ($self) = @_; + my $fh = $self; + ${ *$fh }{ _error }; +} + + +sub rollback +{ + my ($self) = @_; + my $fh = $self; + my $temp = ${ *$fh }{ _temp }; + if (-f $temp) { unlink $temp;} +} + + +sub DESTROY +{ + my ($self) = @_; + $self->rollback; +} + + +=head1 NAME + +IO::Atomic.pm - atomic operation + + +=head1 SYNOPSIS + + use IO::Atomic; + my $wh = new IO::Atomic->open($file); + print $wh "new/updated things ..."; + $wh->close; + +So, in usual cases, you use in this way. + + use FileHandle; + use IO::Atomic; + + # get read handle for $file + my $rh = new FileHandle $file; + + # get handle to update $file + my $wh = new IO::Atomic->open($file); + while (<$rh>) { + print $wh "new/updated things ..."; + } + $wh->close; + $rh->close; + +You can use this method to open $file for both read and write. + + use IO::Atomic; + my ($rh, $wh) = IO::Atomic->rw_open($file); + while (<$rh>) { + print $wh "new/updated things ..."; + } + $wh->close; + $rh->close; + + +=head1 DESCRIPTION + +=head2 new + +=item Function() + + +=head1 AUTHOR + +=head1 COPYRIGHT + +Copyright (C) 2001 __YOUR_NAME__ + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +IO::__MODULE_NAME__.pm appeared in fml5. + +=cut + + +1; diff --git a/fml/lib/IO/MapAdapter.pm b/fml/lib/IO/MapAdapter.pm new file mode 100644 index 00000000..658f8623 --- /dev/null +++ b/fml/lib/IO/MapAdapter.pm @@ -0,0 +1,305 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package IO::MapAdapter; +use strict; +use Carp; + + +BEGIN {} + + +sub new +{ + my ($self, $args) = @_; + my ($type) = ref($self) || $self; + my ($me) = {}; + + if ( ref($args) eq 'CODE' ) { + $me->{_type} = 'array_on_memory'; + eval { &$args($me);}; + _log($me, $@) if $@; + } + else { + if ($args =~ /file:(\S+)/ || $args =~ m@^(/\S+)@) { + $me->{_file} = $1; + $me->{_type} = 'file'; + } + elsif ($args =~ /unix\.group:(\S+)/) { + $me->{_name} = $1; + $me->{_type} = 'unix.group'; + } + elsif ($args =~ /(ldap|mysql|postgresql):(\S+)/) { + $me->{_type} = $1; + $me->{_schema} = $2; + + # lowercase the '_type' syntax + $me->{_type} =~ tr/A-Z/a-z/; + } + else { + my $s = "IO::MapAdapter::new: args='$args' is unknown."; + print STDERR $s, "\n"; + _log($me, $s); + } + } + + return bless $me, $type; +} + + +sub _log +{ + my ($self, $mesg) = @_; + $self->{ _error } = $mesg; +} + + +sub error +{ + my ($self) = @_; + return $self->{ _error }; +} + + +sub dump_variables +{ + my ($self, $args) = @_; + my ($k, $v); + while (($k, $v) = each %$self) { + print STDERR "IO::Map.debug: $k => $v\n"; + } +} + + +sub open +{ + my ($self, $flag) = @_; + + # default flag is "r" == "read open" + $flag ||= 'r'; + + if ($self->{'_type'} eq 'file') { + my $file = $self->{_file}; + eval q{ use FileHandle;}; + my $fh = new FileHandle $file, $flag; + if (defined $fh) { + $self->{_fh} = $fh; + return $fh; + } + else { + $self->_log("Error: cannot open $file $flag"); + } + } + elsif ($self->{'_type'} eq 'unix.group') { + my @x = getgrnam( $self->{_name} ); + my @members = split ' ', $x[3]; + $self->{_members} = \@members; + $self->{_num_members} = $#members; + $self->{_counter} = 0; + return defined @members ? \@members : undef; + } + elsif ($self->{'_type'} eq 'array_on_memory') { + my $r_array = $self->{ _recipients_array_on_memory }; + my @members = @$r_array; + $self->{_members} = $r_array; + $self->{_num_members} = $#members; + $self->{_counter} = 0; + return defined @members ? \@members : undef; + } + elsif ($self->{'_type'} eq 'ldap' || + $self->{'_type'} eq 'mysql' || + $self->{'_type'} eq 'postgresql' + ) { + return undef; + } + else { + $self->_log("Error: type=$self->{_type} is unknown type."); + } +} + + +my $c = 0; +my $ec = 0; +sub line_count { my ($self) = @_; return "${ec}/${c}";} + + +# aliases for convenience +sub get_member { my ($self) = @_; $self->_get_address;} +sub get_active { my ($self) = @_; $self->_get_address;} +sub get_recipient { my ($self) = @_; $self->_get_address;} +sub _get_address +{ + my ($self) = @_; + + if ($self->{'_type'} eq 'file') { + my ($buf) = ''; + my $fh = $self->{_fh}; + + if (defined $fh) { + INPUT: + while ($buf = <$fh>) { + $c++; # for benchmark (debug) + next INPUT if not defined $buf; + next INPUT if $buf =~ /^\s*$/o; + next INPUT if $buf =~ /^\#/o; + next INPUT if $buf =~ /\sm=/o; + next INPUT if $buf =~ /\sr=/o; + next INPUT if $buf =~ /\ss=/o; + last INPUT; + } + + if (defined $buf) { + my @buf = split(/\s+/, $buf); + $buf = $buf[0]; + $buf =~ s/[\r\n]*$//o; + $ec++; + } + return $buf; + } + return undef; + } + elsif ($self->{'_type'} eq 'unix.group') { + my $i = $self->{_counter}++; + my $ra = $self->{_members}; + defined $$ra[ $i ] ? $$ra[ $i ] : undef; + } + elsif ($self->{'_type'} eq 'array_on_memory') { + my $i = $self->{_counter}++; + my $ra = $self->{_members}; + defined $$ra[ $i ] ? $$ra[ $i ] : undef; + } + elsif ($self->{'_type'} eq 'ldap' || + $self->{'_type'} eq 'mysql' || + $self->{'_type'} eq 'postgresql' + ) { + $self->_log("Error: not yet implemented"); + return undef; + } + else { + $self->_log("Error: type=$self->{_type} is unknown type."); + } +} + + +# raw line reading +sub getline +{ + my ($self) = @_; + + if ($self->{'_type'} eq 'file') { + my $fh = $self->{_fh}; + $fh->getline; + } + elsif ($self->{'_type'} eq 'unix.group') { + my $i = $self->{_counter}++; + my $ra = $self->{_members}; + defined $$ra[ $i ] ? $$ra[ $i ] : undef; + } + elsif ($self->{'_type'} eq 'ldap' || + $self->{'_type'} eq 'mysql' || + $self->{'_type'} eq 'postgresql' + ) { + $self->_log("Error: not yet implemented"); + return undef; + } + else { + $self->_log("Error: type=$self->{_type} is unknown type."); + } +} + + +sub getpos +{ + my ($self) = @_; + + if ($self->{'_type'} eq 'file') { + my $fh = $self->{_fh}; + tell($fh); + } + elsif ($self->{'_type'} eq 'unix.group') { + $self->{_counter}; + } + elsif ($self->{'_type'} eq 'array_on_memory') { + $self->{_counter}; + } + else { + $self->_log("Error: type=$self->{_type} is unknown type."); + } +} + + +sub setpos +{ + my ($self, $pos) = @_; + + if ($self->{'_type'} eq 'file') { + my $fh = $self->{_fh}; + seek($fh, $pos, 0); + } + elsif ($self->{'_type'} eq 'unix.group') { + $self->{_counter} = $pos; + } + elsif ($self->{'_type'} eq 'array_on_memory') { + $self->{_counter} = $pos; + } + else { + $self->_log("Error: type=$self->{_type} is unknown type."); + } +} + + +sub eof +{ + my ($self) = @_; + + if ($self->{'_type'} eq 'file') { + my $fh = $self->{_fh}; + $fh->eof; + } + elsif ($self->{'_type'} eq 'unix.group') { + $self->{_counter} > $self->{_num_members} ? 1 : 0; + } + elsif ($self->{'_type'} eq 'array_on_memory') { + $self->{_counter} > $self->{_num_members} ? 1 : 0; + } + else { + $self->_log("Error: type=$self->{_type} is unknown type."); + } +} + + +sub close +{ + my ($self) = @_; + + if ($self->{'_type'} eq 'file') { + $self->{_fh}->close; + } + elsif ($self->{'_type'} eq 'unix.group') { + ; + } + elsif ($self->{'_type'} eq 'array_on_memory') { + ; + } + else { + $self->_log("Error: type=$self->{_type} is unknown type."); + } +} + + +sub DESTROY +{ + my ($self) = @_; + $self->close; + undef $self; +} + + +1; diff --git a/fml/lib/IO/index.ja.html b/fml/lib/IO/index.ja.html new file mode 100644 index 00000000..4705f6d2 --- /dev/null +++ b/fml/lib/IO/index.ja.html @@ -0,0 +1,5 @@ +<UL> + <LI> + <A HREF=MapAdapter.pm>MapAdapter.pm</A> + +</UL> diff --git a/fml/lib/Netlib/@template b/fml/lib/Netlib/@template new file mode 100644 index 00000000..81d97312 --- /dev/null +++ b/fml/lib/Netlib/@template @@ -0,0 +1,4 @@ +# Descriptions: +# Arguments: $self $args +# Side Effects: +# Return Value: none diff --git a/fml/lib/Netlib/CheckSum.pm b/fml/lib/Netlib/CheckSum.pm new file mode 100644 index 00000000..75de112c --- /dev/null +++ b/fml/lib/Netlib/CheckSum.pm @@ -0,0 +1,65 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package Netlib::CheckSum; +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK); +use Carp; +require Exporter; + +@ISA = qw(Exporter); + +sub new +{ + my ($self) = @_; + my ($type) = ref($self) || $self; + my $me = {}; + return bless $me, $type; + } + + +sub md5 + { +} + + +=head1 NAME + +Netlib::CheckSum.pm - what is this + + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 new + +=item Function() + + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2001 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +Netlib::CheckSum.pm appeared in fml5. + +=cut + + +1; diff --git a/fml/lib/Netlib/INET4.pm b/fml/lib/Netlib/INET4.pm new file mode 100644 index 00000000..ec6e8006 --- /dev/null +++ b/fml/lib/Netlib/INET4.pm @@ -0,0 +1,83 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package Netlib::INET4; +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK); +use Carp; +use Netlib::Utils; + +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(_connect4); + +sub _connect4 +{ + my ($self, $args) = @_; + my $mta = $args->{ _mta }; + my $socket = ''; + + # avoid croak() in IO::Socket module; + eval { + local($SIG{ALRM}) = sub { Log("Error: timeout to connect $mta");}; + use IO::Socket; + $socket = new IO::Socket::INET($mta); + }; + if ($@) { + Log("Error: cannot make socket for $mta"); + $self->_error_why("Error: cannot make socket: $@"); + return undef; + } + + if (defined $socket) { + Log("(debug) o.k. connected to $mta"); + $self->{'_socket'} = $socket; + $socket->autoflush(1); + return $socket; + } + else { + Log("(debug) error. fail to connect $mta"); + $self->_error_why("Error: cannot open socket: $!"); + return undef; + } +} + + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 new + +=item Function() + + +=head1 AUTHOR + +=head1 COPYRIGHT + +Copyright (C) 2001 __YOUR_NAME__ + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +FML::__MODULE_NAME__.pm appeared in fml5. + +=cut + +1; diff --git a/fml/lib/Netlib/INET6.pm b/fml/lib/Netlib/INET6.pm new file mode 100644 index 00000000..ac84afa7 --- /dev/null +++ b/fml/lib/Netlib/INET6.pm @@ -0,0 +1,174 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package Netlib::INET6; +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK); +use Carp; +use Netlib::Utils; + +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(is_ipv6_ready is_ipv6_mta_syntax _connect6); + +sub _we_can_use_Socket6 +{ + my ($self, $args) = @_; + + eval q{ + use Socket; + use Socket6; + }; + + if ($@ =~ /Can\'t locate Socket6.pm/) { + $self->{_ipv6_ready} = 'no'; + } + else { + Log("IPv6 ready"); + $self->{_ipv6_ready} = 'yes'; + } +} + + +sub is_ipv6_ready +{ + my ($self, $args) = @_; + + # probe the IPv6 availability for the first time + unless ($self->{_ipv6_ready}) { + _we_can_use_Socket6($self, $args); + }; + + $self->{_ipv6_ready} eq 'yes' ? 1 : 0; +} + + +sub is_ipv6_mta_syntax +{ + my ($self, $host) = @_; + my ($x_host, $x_port); + + # check the mta syntax whether it is ipv6 form or not. + if ( $host =~ /\[([\d:]+)\]:(\d+)/) { + ($x_host, $x_port) = ($1, $2); + return ($x_host, $x_port); + } + else { + return wantarray ? () : undef; + } +} + + +sub _connect6 +{ + my ($self, $args) = @_; + my $mta = $args->{ _mta }; + + # check the mta syntax is $ipv6_addr:$port or not. + my ($host, $port) = $self->is_ipv6_mta_syntax( $args->{ _mta } ); + + # if mta is ipv6 raw address syntax, + # try to parse $mta to $host:$port style. + unless ($host) { + if ($mta =~ /(\S+):(\S+)/) { + ($host, $port) = ($1, $2); + } + } + + # hmm, invalid MTA + unless ($host && $port) { + Log("_connect6: cannot find mta=$mta"); + $self->{_socket} = undef; + return undef; + } + + $self->{_socket} = undef; + return undef; + + eval q{ + use IO::Handle; + use Socket; + use Socket6; + + my ($family, $type, $proto, $saddr, $canonname); + my $fh = new IO::Socket; + my $inet6_family = &AF_INET6; + + # resolve socket info by getaddrinfo() + my @res = getaddrinfo($host, $port, AF_UNSPEC, SOCK_STREAM); + $family = -1; + + LOOP: + while (scalar(@res) >= 5) { + ($family, $type, $proto, $saddr, $canonname, @res) = @res; + + my ($host, $port) = + getnameinfo($saddr, NI_NUMERICHOST | NI_NUMERICSERV); + + # check only IPv6 case here. + next LOOP if $family != $inet6_family; + + socket($fh, $family, $type, $proto) || do { + Log("Error: cannot create IPv6 socket"); + next LOOP; + }; + if (connect($fh, $saddr)) { + Log("(debug6) o.k. connect $host"); + last LOOP; + } + else { + Log("Error: cannot connect via IPv6"); + } + + $family = -1; + } + + if ($family != -1) { + $self->{_socket} = $fh; + Log("connected to $host:$port by IPv6"); + } else { + $self->{_socket} = undef; + Log("(debug6) fail to connect $host:$port by IPv6"); + } + }; +} + + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 new + +=item Function() + + +=head1 AUTHOR + +=head1 COPYRIGHT + +Copyright (C) 2001 __YOUR_NAME__ + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +FML::__MODULE_NAME__.pm appeared in fml5. + +=cut + +1; diff --git a/fml/lib/Netlib/SMTP.ja.pod b/fml/lib/Netlib/SMTP.ja.pod new file mode 100644 index 00000000..2df018e3 --- /dev/null +++ b/fml/lib/Netlib/SMTP.ja.pod @@ -0,0 +1,83 @@ +=head1 NAME + +fml5 のメール配送システムについて + +=head1 DESCRIPTION + +=head2 fml4 と fml5 の相違点 + +fml5 の最大の目的の一つは、メンバーリストの取得と操作の統合と抽象化で +す。Netlib::SMTP は次のように使います。 + + +=head1 使い方 + +=head2 Netlib::* クラスの使い方について + +Netlib::* に属するクラスは SMTP および LMTP 配送へのインターフェイスを +提供します。 + +Netlib::SMTP は次のように使います。 + + use Netlib::SMTP; + my $service = new Netlib::SMTP { + log_function => $fp, + socket_timeout => 2, + }; + + my $ref_to_array = [ 'kenken@nuinui.net' ]; + my $recipient_maps = 'file:/var/spool/ml/elena/actives'; + + $service->deliver( + { + 'mta' => 'localhost:25', + + 'smtp_sender' => 'rudo@nuinui.net', + 'recipient_array' => $ref_to_array, + 'recipient_maps' => $recipient_maps, + + 'header' => $header, + 'body' => $body, + }); + if ($service->error) { Log($service->error); return;} + +ここで $header はヘッダで、FML::Header オブジェクトです。 +そして $body はメール本文で、FML::Body オブジェクトです。 + +=head1 コンポーネント + + Netlib::SMTP >-| + |- Netlib::Utils + |- Netlib::INET4 >--- Socket + |- Netlib::INET6 >--- Socket + | |- Socket6 + | + |- FML::IO::Map + | + |- IO::Socket + +Netlib::SMTP uses Netlib::Utils, Netlib::INET4 and Netlib::INET6. +Netlib::SMTP also uses FML::IO::Map to resolve $recipient_maps +operations. + +=head1 参照 + +L<"Netlib::SMTP">, +L<"FML::IO::Map"> + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2001 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +Netlib class appeared in fml5. +fml5 is fully rewrite of fml4 based on the experience of fml4 +(1993-2001). diff --git a/fml/lib/Netlib/SMTP.pm b/fml/lib/Netlib/SMTP.pm new file mode 100644 index 00000000..543d9888 --- /dev/null +++ b/fml/lib/Netlib/SMTP.pm @@ -0,0 +1,698 @@ +#-*- perl -*- +# +# Copyright (C) 2000-2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +### XXX comment templates ### +# Descriptions: +# Arguments: $self $args +# Side Effects: +# Return Value: none +############################# + + +package Netlib::SMTP; +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK); +use Carp; +use IO::Socket; +use Netlib::Utils; +use Netlib::INET4; +use Netlib::INET6; + +require Exporter; +@ISA = qw(Exporter); + + +BEGIN {} + + +# Descriptions: Netlib::SMTP constructor +# Arguments: $self $args +# Side Effects: $self ($me) hash has some default values +# Return Value: object +sub new +{ + my ($self, $args) = @_; + my ($type) = ref($self) || $self; + my $me = {}; # malloc new SMTP session struct + + # _recipient_limit: maximum recipients in one smtp session. + # _socket_timeout: basic timeout parameter for smtp session + # _log_function: pointer to the log() function + $me->{_recipient_limit} = $args->{recipient_limit} || 1000; + $me->{_socket_timeout} = $args->{socket_timeout} || 10; + $me->{_log_function} = $args->{log_function}; + + _initialize_delivery_session($me, $args); + + # define package global pointer to the log() function + $LogFunctionPointer = $args->{log_function}; + + return bless $me, $type; +} + + +# Descriptions: send a (SMTP/LMTP) command string to BSD socket +# Arguments: $self $command_string +# Side Effects: log file by _smtplog +# set _last_command and _error_action in object itself +# Return Value: none +sub _send_command +{ + my ($self, $command) = @_; + my $socket = $self->{'_socket'}; + + $self->{_last_command} = $command; + $self->{_error_action} = ''; + $self->_smtplog($command); + + if (defined $socket) { + $socket->print($command, "\r\n"); + } + else { + Log("Error: _send_command: undefined socket"); + } +} + + +# Descriptions: receive a reply for a (SMTP/LMTP) command +# Arguments: $self +# Side Effects: log file by _smtplog +# Return Value: none +sub _read_reply +{ + my ($self) = @_; + my $socket = $self->{'_socket'}; + + # unique identifier to clarify the trapped error message + my $id = $$; + + # toggle flag whether we should check SMTP attributes or not. + # we should check it only in HELO phase. + my $check_attributes = 0; + if ($self->{_last_command} =~ /^(EHLO|HELO|LHLO)/) { + $check_attributes = 1; + } + + # XXX Attention! dynamic scope by local() for %SIG is essential. + # See books on Perl for more details on my() and local() difference. + eval { + local($SIG{ALRM}) = sub { die("$id socket timeout")}; + alarm( $self->{_socket_timeout} ); + my $buf = ''; + + SMTP_REPLY: + while (1) { + $buf = $socket->getline; + $self->_smtplog($buf); + + # check smtp attributes + if ($check_attributes) { + if ($buf =~ /^250.PIPELINING/i) { + $self->{'_can_use_pipelining'} = 'yes'; + } + if ($buf =~ /^250.ETRN/i) { + $self->{'_can_use_etrn'} = 'yes'; + } + if ($buf =~ /^250.SIZE\s+(\d+)/i) { + $self->{'_size_limit'} = $1; + } + } + + # store the latest status code + if ($buf =~ /^(\d{3})/) { $self->_set_status_code($1);} + + # check status code + if ($buf =~ /^[45]\d{2}\s/) { + Log($buf); + die("$id retry"); + } + + # end of reply e.g. "250 ..." + last SMTP_REPLY if $buf =~ /^\d{3}\s/; + } + }; + + if ($@ =~ /$id retry/) { + $self->{'_error_action'} = "retry"; + } + + if ($@ =~ /$id socket timeout/) { + my $x = $self->{'_last_command'}; + Log("Error: smtp reply for \"$x\" is timeout"); + $self->_error_why("Error: smtp reply for \"$x\" is timeout"); + } +} + + +# Descriptions: connect(2) +# 1. try connect(2) by IPv6 if we can use Socket6.pm +# 2. try connect(2) by IPv4 +# if $host is not IPv6 raw address e.g. [::1]:25 +# Arguments: $self $args +# Side Effects: set file handle (BSD socket) in $self->{_socket} +# Return Value: file handle (created BSD socket) or undef() +sub _connect +{ + my ($self, $args) = @_; + my $mta = $args->{'_mta'} || '127.0.0.1:25'; + my $socket; + + # 1. try to connect(2) $args->{ _mta } by IPv6 if we can use Socket6. + if ($self->is_ipv6_ready($args)) { + $self->_connect6($args); + my $socket = $self->{_socket}; + return $socket if defined $socket; + } + else { + Log("(debug) IPv6 is not ready"); + } + + # 2. try to connect(2) $args->{ _mta } by IPv4. + # XXX check the _mta syntax. + # XXX if $args->{ _mta } looks [$ipv6_addr]:$port style, + # XXX we do not try to connect the host by IPv4. + if ( $self->is_ipv6_mta_syntax($mta) ) { + Log("(debug) not try MTA $args->{_mta}"); + return undef; + } + else { + $self->_connect4($args); + } +} + + +# Descriptions: close BSD socket +# Arguments: $self +# Side Effects: +# Return Value: none +sub close +{ + my ($self) = @_; + my $socket = $self->{'_socket'}; + + if (defined $socket) { + $socket->close; + } + else { + Log("Error: try to close invalid socket"); + } +} + + +############################################################ +##### +##### SMTP delivery main loop +##### + + +# Descriptions: main delivery loop for each recipient_maps and each mta. +# real delivery is done within _deliver() method. +# algorithm: +# for each $map { +# for each $mta { +# call _deliver() +# send recipients up to $recipient_limit +# } +# } +# +# Arguments: $self $args +# Side Effects: See Netlib::Utils for recipient_map utilities +# to track the delivery process status. +# Return Value: none +sub deliver +{ + my ($self, $args) = @_; + + # recipient limit + $self->{_recipient_limit} = $args->{recipient_limit} || 1000; + + # temporary hash to check whether the map/mta is used already. + my %used_mta = (); + my %used_map = (); + + # prepare loop for each mta and map + my @mta = split(/\s+/, $args->{ mta } || '127.0.0.1:25'); + my @maps = (); + if ( $args->{ recipient_maps } ) { + @maps = split(/\s+/, $args->{ recipient_maps }); + } + + # alloc virtual recipient map + if (ref( $args->{ recipient_array } ) eq 'ARRAY') { + my $map = $self->_alloc_recipients_array_on_memory($args); + push(@maps, $map); + } + + MAP: + for my $map ( @maps ) { + # uniq $map + next if $used_map{ $map }; $used_map{ $map } = 1; + + $self->_set_target_map($map); + $self->_set_map_status($map, 'not done'); + $self->_set_map_position($map, 0); + + # To avoid infinite loop, we enforce some artificial limit. + # The loop evaluation is limited to "4 * $number_of_mta" for each $map. + my $loop_count = 0; + my $max_loop_count = ($#mta * 4) || 4; + + MTA_RETRY_LOOP: + while (1) { + my $n_mta = 0; + + # check infinite loop + if ($loop_count++ > $max_loop_count) { + Log("Error: infinite loop for map=$map"); + last MTA_RETRY_LOOP; + } + + MTA: + for my $mta (@mta) { + # uniq $mta + next if $used_mta{ $mta }; $used_mta{ $mta } = 1; + + # count the number of effective mta in this inter loop. + $n_mta++; + + # o.k. try to deliver mail by using $mta. + Log("(debug) use $mta for map=$map"); + $args->{ _mta } = $mta; + $self->_deliver($args); + + # remove error messages for the next _deliver() session. + $self->error_reset; + + # we read the whole $map now. + if ($self->_get_map_status($map) eq 'done') { + last MTA; + } + } # end of MTA: loop + + # end of MTA_RETRY_LOOP: loop + if ($self->_get_map_status($map) eq 'done') { + last MTA_RETRY_LOOP; + } + + # NO effective mta in this inter loop. It impiles that + # we used all MTA candidates. We reuse @mta again. + if ($n_mta == 0) { + Log("(debug) we used all MTA candidates. reuse \$mta"); + undef %used_mta; + next MTA_RETRY_LOOP; + } + } + } + + # clean up recipient_map information after "all delivery" + # CAUTION: this mapinfo tracks the delivery status. + $self->_reset_mapinfo; + + if ( $self->{ _num_recipients } ) { + Log( "recipients: ". $self->{ _num_recipients } ); + } +} + + +# Descriptions: ordinary SMTP sequence (see RFC821 for more details) +# >220 I am some MTA ... +# <EHLO/HELO myname +# >250 ok +# <MAIL FROM:<$sender> +# >250 ok +# <RCPT TO:<$recipient> +# >250 oK +# <DATA +# >354 ... +# < message +# <. +# >250 oK +# <QUIT +# >221 good bye +# Arguments: $self $args +# Side Effects: remove error messages when we return from here +# for the next _deliver() session. +# Return Value: none +sub _deliver +{ + my ($self, $args) = @_; + + $self->_initialize_delivery_session($args); + + # prepare smtp information + my $myhostname = $args->{ myhostname } || 'localhost'; + + # 0. create BSD SOCKET as the communication terminal + # IF_ERROR_FOUND: do nothing and return as soon as possible + my $socket = $self->_connect($args); + $socket || return; + + # 1. receive the first "220 .." message + # If you faces some error in this stage, you have to do nothing + # since smtp connection has not established yet. + # IF_ERROR_FOUND: do nothing and return as soon as possible + $self->_read_reply; + if ($self->error) { return;} + + # 2. EHLO/HELO; + # IF_ERROR_FOUND: do nothing and return as soon as possible + $self->_send_command("EHLO $myhostname"); + $self->_read_reply; + if ($self->error) { $self->_reset_smtp_transaction; return;} + + # 3. MAIL FROM; + # IF_ERROR_FOUND: do nothing and return as soon as possible + $self->_send_mail_from($args); + if ($self->error) { $self->_reset_smtp_transaction; return;} + + # 4. RCPT TO; ... send list of recipients + # IF_ERROR_FOUND: roll back the process to the state before this + $self->_send_recipient_list($args); + if ($self->error) { + $self->_rollback_map_position; + $self->_reset_smtp_transaction; + return; + } + + # 5. DATA; send the mail body itself + # IF_ERROR_FOUND: handled in _send_data_to_mta(), so + # return as soon as possible from here. + $self->_send_data_to_mta($args); + if ($self->error) { return;} + + # 6. QUIT; SMTP session closing ... + # IF_ERROR_FOUND: do nothing ? + $self->_send_command("QUIT"); + $self->_read_reply; + if ($self->error) { $self->_reset_smtp_transaction; return;} +} + + +# Descriptions: initialize _deliver() process +# this routine is called at the first phase in _deliver() +# Arguments: $self $args +# Side Effects: +# Return Value: none +sub _initialize_delivery_session +{ + my ($self, $args) = @_; + $self->{ _last_command } = ''; + $self->{ _status_code } = ''; +} + + +############################################################ +##### +##### MAIL FROM: +##### + +# Descriptions: send SMTP command "MAIL FROM" +# Arguments: $self $args +# Side Effects: none +# Return Value: none +# See Also: RFC821, RFC1123 +# TODO: VERP's +sub _send_mail_from +{ + my ($self, $args) = @_; + my $sender = $args->{ smtp_sender }; + $self->_send_command("MAIL FROM:<$sender>"); + $self->_read_reply; +} + + + +############################################################ +##### +##### RCPT TO: +##### + +# Descriptions: We evaluate recipient_maps parameter here. +# You can use a lot of classes for this directive: e.g. +# file, UNIX's /etc/group, YP, SQL, LDAP, ... +# Example: recipient_maps = file:members +# unix.group:admin +# mysql:toymodel +# IO::MapAdapter class is essential to handle abstract +# $recipient_map. +# Arguments: $self $args +# Side Effects: $self->{ _retry_recipient_table } has recipients which +# causes some errors. +# _{set,get}_map_position() and _{set,get}_map_status() +# tracks the delivery process. +# Return Value: none +sub _send_recipient_list_by_recipient_map +{ + my ($self, $args) = @_; + my $map = $self->_get_target_map; + + # open abstract recipient list objects. + # $map syntax is "type:parameter", e.g., + # file:$filename mysql:$schema_name + use IO::MapAdapter; + my $obj = new IO::MapAdapter $map; + + unless (defined $obj) { + Log("Error: cannot get object for $map by IO::MapAdapter"); + } + else { # $obj is good. + my $rcpt; + my $num_recipients = 0; + my $recipient_limit = $self->{_recipient_limit}; + + $obj->open; + + # roll back the previous file offset + if ($self->_get_map_position($map) > 0) { + $obj->setpos( $self->_get_map_position($map) ); + } + + # XXX $obj->get_recipient returns a mail address. + RCPT_INPUT: + while (defined ($rcpt = $obj->get_recipient)) { + $num_recipients++; + $self->_send_command("RCPT TO:<$rcpt>"); + $self->_read_reply; + + # save addresses to retry later. + if ($self->{_error_action} eq 'retry') { + $self->{ _retry_recipient_table }->{ $rcpt } = 'retry'; + } + + last RCPT_INPUT if $num_recipients >= $recipient_limit; + } + + # save the current position in the file handle + $self->_set_map_position($map, $obj->getpos); + + # done. + if ($obj->eof) { + $self->_set_map_status($map, 'done'); + } + + # ends + $obj->close; + + # count up the total number of recipients + $self->{ _num_recipients } += $num_recipients; + + unless ($num_recipients) { + Log("Error: no recipients for $map"); + $self->_send_command("RSET"); + $self->_read_reply; + } + } +} + + +# Descriptions: send "RCPT TO:<recipient>" to MTA +# Arguments: $self $args +# Side Effects: none +# Return Value: none +sub _send_recipient_list +{ + my ($self, $args) = @_; + + # evaluate recipient_maps + if ( $self->_get_target_map ) { + $self->_send_recipient_list_by_recipient_map($args); + } +} + + +# Descriptions: create CODE REFERECE to handle recipients array on memory +# Arguments: $self $args +# Side Effects: $me is referenced, so not destroyed. It is a closure (?). +# Return Value: CODE REFERENCE +sub _alloc_recipients_array_on_memory +{ + my ($self, $args) = @_; + return sub { + my ($me) = @_; + $me->{ _recipients_array_on_memory } = $args->{ recipient_array }; + }; +} + + +############################################################ +##### +##### DATA: +##### + +# Descriptions: send the header part of the message to socket +# Arguments: $self $socket $ref_to_header +# $ref_to_header is the FML::Header class object. +# Side Effects: none +# Return Value: none +sub _send_header_to_mta +{ + my ($self, $socket, $header) = @_; + + # get header + my $h = $header->as_string($socket); + $h =~ s/\n/\r\n/g; + print $socket $h; + $self->_smtplog($h); +} + + +# Descriptions: send the body part of the message to socket +# replace "\n" in the end of line with "\r\n" on memory. +# We should do it to use as less memory as possible. +# So we use substr() to process each line. +# Arguments: $self $socket $ref_to_body +# Side Effects: none +# Return Value: none +sub _send_body_to_mta +{ + my ($self, $socket, $r_body) = @_; + my ($pp, $p, $maxlen, $len, $buf, $pbuf); + + $pp = 0; + $maxlen = length($$r_body); + + # write each line in buffer + SMTP_IO: + while (1) { + $p = index($$r_body, "\n", $pp); + $len = $p - $pp + 1; + $buf = substr($$r_body, $pp, ($p < 0 ? $maxlen-$pp : $len)); + if ($buf !~ /\r\n$/) { $buf =~ s/\n$/\r\n/;} + + # ^. -> .. + $buf =~ s/^\./../; + + $self->_smtplog($buf); + print $socket $buf; + + last SMTP_IO if $p < 0; + $pp = $p + 1; + } +} + + +# Descriptions: send message itself to file handle (BSD socket here) +# Arguments: $self $args +# Side Effects: +# Return Value: none +# TODO: MIME/multipart +sub _send_data_to_mta +{ + my ($self, $args) = @_; + + + # XXX debug; + # Log("(debug) not send DATA now"); return ; + # + + + # prepare smtp information + my $body = $args->{ body }; + my $header = $args->{ header }; + my $socket = $self->{'_socket'}; + + if (defined $body) { + $self->_send_command("DATA"); + $self->_read_reply; + + # XXX if "DATA" transaction cannot start, retry ? + if ($self->_get_status_code != '354' || $self->error) { + Log($self->error); + return undef; + } + + # 1. header; send header + $self->_send_header_to_mta($socket, $header); + + # 2. separator between header and body + print $socket "\r\n"; + $self->_smtplog("\r\n"); + + # 3. body; send(copy) body on memory to socket each line + $self->_send_body_to_mta($socket, $body); + + # end "DATA" transaction + $self->_send_command("."); + $self->_read_reply; + } +} + + +############################################################ +##### +##### QUIT / RSET +##### + +# Descriptions: send the SMTP reset "RSET" command +# Arguments: $self $args +# Side Effects: none +# Return Value: none +sub _reset_smtp_transaction +{ + my ($self, $args) = @_; + $self->_send_command("RSET"); + $self->_read_reply; + Log("Info: reset smtp transcation"); +} + + +=head1 NAME + +Netlib::SMTP.pm - SMTP functions + +=head1 SYNOPSIS + + use Netlib::SMTP; + my $service = new Netlib::SMTP $CurProc; + + +=head1 DESCRIPTION + + + +=head1 AUTHOR + +Ken'ichi Fukamachi + + +=head1 COPYRIGHT + +Copyright (C) 2001 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +Netlib::SMTP.pm appeared in fml5. + +=cut + +1; diff --git a/fml/lib/Netlib/Utils.pm b/fml/lib/Netlib/Utils.pm new file mode 100644 index 00000000..c5c3c883 --- /dev/null +++ b/fml/lib/Netlib/Utils.pm @@ -0,0 +1,196 @@ +#-*- perl -*- +# +# Copyright (C) 2000-2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package Netlib::Utils; +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK $LogFunctionPointer); +use Carp; + +require Exporter; +@ISA = qw(Exporter); + +@EXPORT = qw( + Log + _smtplog + + $LogFunctionPointer + + _error_why + error + error_reset + + _set_status_code + _get_status_code + + _set_target_map + _get_target_map + _set_map_status + _set_map_position + _get_map_status + _get_map_position + _rollback_map_position + _reset_mapinfo + ); + +sub Log +{ + my ($buf) = @_; + + # function pointer to logging function + my $fp = $LogFunctionPointer; + + if ($fp) { + eval &$fp($buf); + print STDERR $@, "\n" if $@; + } + else { + print STDERR @_, "\n"; + } +} + + +sub _smtplog +{ + my ($self, $buf) = @_; + + if (defined $buf) { + print $buf; + print "\n" if $buf !~ /\n$/o; + } +} + + +sub _error_why +{ + my ($self, $mesg) = @_; + $self->{'_error_reason'} = $mesg; +} + + +sub error +{ + my ($self, $args) = @_; + return $self->{'_error_reason'}; +} + + +sub error_reset +{ + my ($self, $args) = @_; + my $msg = $self->{'_error_reason'}; + undef $self->{'_error_reason'} if defined $self->{'_error_reason'}; + undef $self->{'_error_action'} if defined $self->{'_error_action'}; + return $msg; +} + + +sub _set_status_code +{ + my ($self, $value) = @_; + $self->{'_status_code'} = $value; +} + + +sub _get_status_code +{ + my ($self) = @_; + $self->{'_status_code'}; +} + + + +############################################################ +##### +##### utility functions to operate $recipient_maps +##### + + +sub _set_target_map +{ + my ($self, $map) = @_; + $self->{ _mapinfo }->{ _curmap } = $map; +} + + +sub _get_target_map +{ + my ($self) = @_; + $self->{ _mapinfo }->{ _curmap }; +} + + +sub _set_map_status +{ + my ($self, $map, $status) = @_; + $self->{ _mapinfo }->{ $map }->{prev_status} = + $self->{ _mapinfo }->{ $map }->{status} || 'not done'; + $self->{ _mapinfo }->{ $map }->{status} = $status; +} + +sub _set_map_position +{ + my ($self, $map, $position) = @_; + $self->{ _mapinfo }->{ $map }->{prev_position} = + $self->{ _mapinfo }->{ $map }->{position} || 0; + $self->{ _mapinfo }->{ $map }->{position} = $position; +} + +sub _get_map_status +{ + my ($self, $map) = @_; + $self->{ _mapinfo }->{ $map }->{status}; +} + +sub _get_map_position +{ + my ($self, $map) = @_; + $self->{ _mapinfo }->{ $map }->{position}; +} + + +sub _rollback_map_position +{ + my ($self) = @_; + my $map = $self->_get_target_map; + + # count the number of rollback to avoid infinite loop + if ( $self->{ _map_rollback_info }->{ $map }->{ count } > 2 ) { + Log("Error: not rollback $map to avoid infinite loop"); + return ; + } + else { + $self->{ _map_rollback_info }->{ $map }->{ count }++; + } + + my $prev_pos = $self->{ _mapinfo }->{ $map }->{prev_position}; + my $pos = $self->{ _mapinfo }->{ $map }->{position}; + $self->_set_map_position($map, $prev_pos); + Log("Info: rollback $map from $pos to $prev_pos"); + + my $prev_status = $self->{ _mapinfo }->{ $map }->{prev_status}; + my $status = $self->{ _mapinfo }->{ $map }->{status}; + $self->_set_map_status($map, $prev_status); + Log("Info: rollback status of $map to '$prev_status'"); +} + + +sub _reset_mapinfo +{ + my ($self) = @_; + $self->_set_target_map(''); + delete $self->{ _mapinfo }; + delete $self->{ _map_rollback_info }; +} + + +1; + + +1; diff --git a/fml/lib/Netlib/index.ja.html b/fml/lib/Netlib/index.ja.html new file mode 100644 index 00000000..cfc25b65 --- /dev/null +++ b/fml/lib/Netlib/index.ja.html @@ -0,0 +1,32 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +Netlib:: クラス +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<CENTER> +Netlib:: クラス +</CENTER> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +<UL> + <LI> + <A HREF=INET6.pm>INET6.pm</A> + + <LI> + <A HREF=SMTP.pm>SMTP.pm</A> + + <LI> + <A HREF=Utils.pm>Utils.pm</A> + +</UL> + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/lib/__template.pm b/fml/lib/__template.pm new file mode 100644 index 00000000..637452b9 --- /dev/null +++ b/fml/lib/__template.pm @@ -0,0 +1,59 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package FML::__HERE_IS_YOUR_MODULE_NAME__; +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK); +use Carp; + +require Exporter; +@ISA = qw(Exporter); + + +sub new +{ + my ($self) = @_; + my ($type) = ref($self) || $self; + my $me = {}; + return bless $me, $type; +} + + +=head1 NAME + +FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this + + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 new + +=item Function() + + +=head1 AUTHOR + +=head1 COPYRIGHT + +Copyright (C) 2001 __YOUR_NAME__ + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +FML::__MODULE_NAME__.pm appeared in fml5. + +=cut + + +1; diff --git a/fml/lib/index.ja.html b/fml/lib/index.ja.html new file mode 100644 index 00000000..cd12d1dd --- /dev/null +++ b/fml/lib/index.ja.html @@ -0,0 +1,88 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +lib/ ディレクトリ +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +<CENTER> +lib/ ディレクトリの階層について +</CENTER> + +<P> +基本方針: +<BR> +使えるものは片っ端から使う（例えば CPAN )。 +そうしないと保守する項目が増える一方のためである。 + +また、保守する人をはっきり区別するためにベンダーごとにディレクトリを分ける。 +例えば CPAN で保守されているものは CPAN/ ディレクトリ以下に入れる。 + +CPAN/ や 3RDPARTY/ 以下のモジュールを変更したい場合は fml5/ 以下でなん +らかのラップをするか、パッチをオリジナルに反映してもらって CPAN/ 以下 +をアップデートする。 + +site_local/ はそのサイト独自のものなので以下なる場合もノータッチ。 + + +<TABLE BORDER=4> + <TR> + <TD> ベンダー名 + <TD> そのディレクトリにおくモジュールの説明 + + <TR> + <TD> fml5/ + <TD> fml5 プロジェクト直轄 + <BR> + この下のモデュールについては + <PRE> + use FML::module; + $p = new module; + $p->function( { what => this , type => that } ); + </PRE> + などといったクラスの階層をとるか、 + <PRE> + use FML::module; + &FML::module::function( \%curproc ); + </PRE> + などといった、書き方をする。 + + <TR> + <TD> CPAN/ + <TD> CPAN で保守されているもの + <BR> + この下のモデュールについては CPAN の説明の通り。 + 単に標準モデュールでないため、ないしは + fml5 のバージョン管理や保守のために、ここに収容。 + + <BR> + <A HREF=CPAN/MANIFEST.txt> CPAN/MANIFEST.txt </A> + に輸入しているモヂュールの一覧を書き、 + <A HREF=CPAN/Changes.txt> CPAN/Changes.txt </A> + に変更を書く。 + + <TR> + <TD> 3RDPARTY/ + <TD> サードパーティ用（予約） + <BR> + 予約されているだけで、fml5 プロジェクトとしては使わない。 + + + <TR> + <TD> site_local/ + <TD> そのサイト独自に保守したいモジュールをおくためのディレクトリ + （予約） + <BR> + 予約されているだけで、fml5 プロジェクトとしては使わない。 +</TABLE> + + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/libexec/Standalone.pm b/fml/libexec/Standalone.pm new file mode 100644 index 00000000..efabc7bf --- /dev/null +++ b/fml/libexec/Standalone.pm @@ -0,0 +1,78 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + + +package Standalone; + +use strict; +use Carp; + +# Descriptions: load "key = value" style configuration. +# It is available to use the following style. +# key = value1 value2 +# value3 +# XXX This file is non-Object Oriented style but +# XXX this is minimum module used in standalone program. +# Arguments: $file +# Side Effects: none +# Return Value: reference to configuration hash +sub load_cf +{ + my ($file) = @_; + my $config = {}; + + use FileHandle; + my $fh = new FileHandle $file; + + if (defined $fh) { + my $curkey; + while (<$fh>) { + next if /^\#/; + chop; + + if (/^([A-Za-z]\w+)\s+=\s*(.*)/) { + my ($key, $value) = ($1, $2); + $curkey = $key; + $config->{$key} = $value; + } + if (/^\s+(.*)/) { + $config->{ $curkey } .= " ". $1; + } + } + $fh->close; + } + else { + croak("Error: cannot open $file"); + } + + _expand_variables( $config ); + return $config; +} + + +# Descriptions: expand $var to the value of $var. +# Arguments: $ref_to_config +# Side Effects: rewrite the given $config +# Return Value: none +sub _expand_variables +{ + my ($config) = @_; + + # expand $xxx style variables + no strict 'refs'; + for my $x (keys %$config) { $$x = $config->{ $x };} + for (keys %$config) { + $config->{ $_ } =~ s/\$([a-z_]+)/${$1}/g; + } +} + + + +1; diff --git a/fml/libexec/boot.ja.html b/fml/libexec/boot.ja.html new file mode 100644 index 00000000..2694eedd --- /dev/null +++ b/fml/libexec/boot.ja.html @@ -0,0 +1,75 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<TITLE> +net/fml ブートの仕方 +</TITLE> +<META http-equiv="Content-Type" + content="text/html; charset=EUC-JP"> +</HEAD> + +<BODY BGCOLOR="#E6E6FA"> +<!-- ================== body =========================================== --> + +<UL> + <LI> libexec/fmlwrapper (wrapper) + <BR> + Bootstrap() を起動する。 + <UL> + <LI> /etc/fml/main.cf を読み込む。 + 読み込むと fml のバージョンが分かる。 + + <LI> @ARGV を評価し、 + どの config.cf 群をロードすればいいのかを準備する。 + default_config.cf はバージョン依存であるので、 + ここで評価することに注意。 + + <LI> libexec/fml ( バージョン依存 )ファイルを + ロードし、 + <UL> + <LI> + ProcessSwitch() を実行して、配送用、コマンドモード用 + プログラム/プロセスなどへ制御を移す(分岐する)。 + + <LI> + $0 から自分の名前を知り、 + どのプロセスへ分岐すればいいのかを判断する。 + + <LI>(ポリモーフィズム) + ダイナミックバインディングし、 + プロセスオブジェクトを生成する( fork(2) という意味ではない)。 + そして、プロセスをスタートさせる。 + + 具体的には + <PRE> + $process = new FML::Process::なにか; + $process->run() + </PRE> + を実行する。 + + </UL> +</UL> + +<PRE> +fmlwrapper (uses) Standalone.pm + | + * 動的にライブラリ(バージョン情報を含む)を選択する + 例: /usr/local/lib/fml/5.000/ほえ/ほえ.pm + | + fml + * 動的にクラスをバインディングしつつ、プロセススタートする。 + 実際のコードは $process->run() などとなるが、書き下すと + このようになるだろう。 + + FML::Process::Distribute->run() | + FML::Process::Command->run() |-(uses)-> FML::Process::Kernel + FML::Process::Mead->run() | | + |- FML::Parse + |- FML::Config + |- FML::Log + |- ... その他 ... +</PRE> + +<!-- =================================================================== --> +</BODY> +</HTML> diff --git a/fml/libexec/fml b/fml/libexec/fml new file mode 100755 index 00000000..cdc342f5 --- /dev/null +++ b/fml/libexec/fml @@ -0,0 +1,121 @@ +#!/usr/local/bin/perl -w +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. +# +# $FML$ +# + +package FML; + +use vars qw($debug); +use strict; +use Carp; + + +# Descriptions: top level process switch +# 1. initialize processes and load configurations from *.cf +# switch to each process according with $0 and @ARGV. +# 2. parse the incoming message(mail) +# 3. start the main transaction +# lock, execute main routine, unlock +# 4. inform error messages, clean up and more ... +# Arguments: $args +# XXX non OO interface +# Side Effects: process running :-) +# Return Value: none +sub main::ProcessSwitch +{ + my ($args) = @_; + + # 1. create process + my $pkg = _package_we_use($args); + eval qq{ require $pkg; }; # XXX require() needs bare words. + $pkg->import(); # fake to use() method. + my $process = $pkg->new($args); # create a new process object + + # 2. parse the incoming message (e.g. STDIN) + $process->prepare($args); + + # 3. start main transaction + $process->run($args); + + # 4. closing the process + $process->finish($args); +} + + +# Descriptions: determine package we need and require() it if needed. +# Arguments: $args +# XXX non OO interface +# Side Effects: +# Return Value: FML::Process::SOMETHING process object +sub _package_we_use +{ + my ($args) = @_; + my $name = $args->{ myname }; + my $pkg = ''; + + if ($name eq 'fml.pl' || $name eq 'distribute') { + $pkg = 'FML::Process::Distribute'; + } + elsif (( $name eq 'fml.pl' && $args->{ options }->{ ctladdr }) || + $name eq 'command') { + $pkg = 'FML::Process::Command'; + } + elsif ($name eq 'fmlserv') { + $pkg = 'FML::Process::Fmlserv'; + } + elsif ($name eq 'mead') { + $pkg = 'FML::Process::Mead'; + } +} + + + +=head1 NAME + +fml -- net/fml switch programs + +=head1 SYNOPSIS + + fml + +=head1 DESCRIPTION + +libexec/fml.pl, the wrapper, executes this program. For example, The +incoming mail to elena@fml.org kicks off libexec/distribute via +libexec/fml.pl, whereas mail to elena-ctl@fml.org kicks off +libexec/command finally. + + incoming_mail => + elena@fml.org => fml.pl => libexec/distribute + elena-ctl@fml.org => fml.pl => libexec/command + elena-admin@fml.org => forwarded to administrator(s) + OR + => libexec/mead + +C<-d> + debug on. + +=head1 FLOW AROUND COMPONENTS + + | <=> FML::BaseSystem + | load configuration files + | start logging service + | + | STDIN => FML::Parse + | $CurProc->{'incoming_mail'} <= + | $CurProc->{'credential'} + | + | (lock) + | prepare article + | $CurProc->{'article'} is spooled in. + | $CurProc->{'article'} <=> Service::SMTP + | (unlock) + V + +=cut + +1; diff --git a/fml/libexec/fmlwrapper b/fml/libexec/fmlwrapper new file mode 100755 index 00000000..33e0d8f1 --- /dev/null +++ b/fml/libexec/fmlwrapper @@ -0,0 +1,103 @@ +#!/usr/local/bin/perl -w +#-*- perl -*- +# +# Copyright (C) 2000-2001 Ken'ichi Fukamachi +# All rights reserved. +# +# $Id$ +# $FML$ +# + +use vars qw($MainCF); +use strict; +use Carp; + +# main configuration file for directory switch +$MainCF = '/etc/fml/main.cf'; + +eval { &Bootstrap();}; +if ($@) { print STDERR "Error: ", $@, "\n";} + +exit 0; + + +BEGIN { + use File::Basename; + unshift(@INC, dirname($0)); + require Standalone; +} + + +sub Bootstrap +{ + # 1. main.cf exists and I can open it? + -f $MainCF || die("cannot find ${MainCF}"); + my $fh = new FileHandle $MainCF; + defined($fh) || die("cannot find ${MainCF}"); + + # 1.1 o.k. try to load main.cf + my $config = Standalone::load_cf($MainCF); + my $libexec_dir = $config->{ libexec_dir }; + my $default_config = $config->{ default_config }; + + # 2. pick up *.cf files to read and set them to @cf. + # We pass it to fml_loader. + # pass *.cf files to libexec/{distribute,command} + # for example + # @cf = ( /etc/fml/defaults/$VERSION/default_config.cf + # /etc/fml/domains/$DOMAIN/config.cf + # /var/spool/ml/elena/config.cf + # ); + my @cf = ($default_config); + my %optargs = (); + for (@ARGV) { + if ($_ eq '--ctladdr') { + $optargs{ ctladdr } = 1; + } + elsif (-d $_) { + push(@cf, "$_/config.cf") if -f "$_/config.cf"; + } + elsif (-f $_) { + push(@cf, "$_"); + } + } + + # 3. reset @INC + use lib qw( $config->{ local_lib_dir } $config->{ lib_dir }); + + # 4. inspect my mode from $0 + use File::Basename; + my $myname = basename($0); + + # 5. o.k. here we go! + require "$libexec_dir/fml"; + ProcessSwitch( + { + main_config => $config, + cf_list => \@cf, + myname => $myname, + options => \%optargs, + }); +} + + +=head1 NAME + +fml.pl -- wrapper which executes the real fml5 programs. + +=head1 SYNOPSIS + +fml.pl C<[-d]> C<[--ctladdr]> $mail_list_address + +=head1 DESCRIPTION + +C<$mail_list_address> + Hmm,,,? + +C<-d> + debug on. + +C<--ctladdr> + execute fml/libexec/command. + +=cut |
