scmail-1.3.orig/0002755000175000017500000000000010101462373014277 5ustar gniibegniibe00000000000000scmail-1.3.orig/doc/0002755000175000017500000000000010101462373015044 5ustar gniibegniibe00000000000000scmail-1.3.orig/doc/embed.scm0000644000175000017500000000167510101451733016631 0ustar gniibegniibe00000000000000(use gauche.regexp) (define (escape str) (set! str (regexp-replace-all #/&/ str "&")) (set! str (regexp-replace-all #// str ">")) str) (define (read-file-and-escape file) (call-with-input-file file (lambda (in) (escape (port->string in))))) (define (main args) (call-with-input-file (cadr args) (lambda (in) (let* ((content (port->string in)) (content (regexp-replace-all #/#\{(.*?)\}/ content (lambda (m) (string-append "
\n"
                                             (read-file-and-escape (rxmatch-substring m 1))
                                             "
\n"))))) (display content)))) 0) scmail-1.3.orig/doc/Makefile0000644000175000017500000000050010101454323016471 0ustar gniibegniibe00000000000000html = scmail.html scmail-ja.html all: $(html) scmail.html: scmail.html.in rm -f scmail.html gosh embed.scm scmail.html.in > scmail.html chmod -w scmail.html scmail-ja.html: scmail-ja.html.in rm -f scmail-ja.html gosh embed.scm scmail-ja.html.in > scmail-ja.html chmod -w scmail-ja.html clean: rm -f $(html) scmail-1.3.orig/doc/scmail-ja.html.in0000644000175000017500000002151610101462207020176 0ustar gniibegniibe00000000000000 scmail: Scheme によるメールフィルタ

English | Japanese

scmail: Scheme によるメールフィルタ

最終更新日: 2004-07-27 (公開日: 2002-10-24)

scmail とは?

scmail は Scheme で書かれたメールフィルタです。メールが届い た瞬間の自動振り分けと、フォルダの中のメールの自動振り分けを 行えます。ベイズ検定によるスパムフィルタ scbayes も含まれています。

新着情報

必要なもの

特長

インストール方法

scmail のインストールは次のように実行して行います。

% gzip -dc scmail-1.3.tar.gz | tar xvf - 
% cd scmail-1.3
Password: (rootのパスワードを入力)
# make
# make install

構成

scmail の設定

~/dot.scmail/config.sample を ~/.scmail/config にコピーして設定ファイルを準 備します。

#{../dot.scmail/config.sample}

scmail-deliver の使い方

scmail-deliver はメールを届いた瞬間 (受信時) に自動振り分け するツールです。scmail-deliver 用の振り分け規則は ~/.scmail/deliver-rules ファイルに定義します。 dot.scmail/deliver-rules.sample をコピーして準備してください。

Sendmail や Postfix などのメールサーバで は ~/.forward ファイルに次のような設定を加えると、メール受信 時に scmail-deliver による自動振り分けが行えるようになります。

| /usr/local/bin/scmail-deliver

POPサーバからのメールの受信に fetchmail を使っ ている場合は ~/.fetchmailrc の mda の設定に /usr/local/bin/scmail-deliver を指定します。

poll pop3.example.org
     protocol apop
     user satoru
     mda "/usr/local/bin/scmail-deliver"
     no mimedecode

scmail-refile の使い方

scmail-refile はフォルダの中のメールを自動振り分けするツール です。scmail-refile 用の振り分け規則は ~/.scmail/refile-rules ファ イルに定義します。dot.scmail/refile-rules.sample をコピーして準備し てください。

scmail-refile はコマンドラインから次のように実行します。

% scmail-refile
refile: inbox/93 -> ml/enkai@coboler/57
refile: inbox/94 -> ml/linux-zaurus/218
refile: inbox/96 -> ml/komatsu-project/26
refile: inbox/98 -> ml/linux-zaurus/219
refile: inbox/99 -> ml/ming/42

実行結果の最初の行は inbox の 93 番のメールが ml/enkai@coboler というフォルダに 57 番のメールとして振り分 けられた、という意味を示しています。~/.scmail/log には同様のレ ポートが時刻付きで記録されます。

% tail -5 ~/.scmail/log
2002-09-26T12:49:31: refile: inbox/93 -> ml/enkai@coboler/57  
2002-09-26T12:49:31: refile: inbox/94 -> ml/linux-zaurus/218  
2002-09-26T12:49:31: refile: inbox/98 -> ml/linux-zaurus/219
2002-09-26T12:49:31: refile: inbox/99 -> ml/ming/42

規則の書き方

サンプルを参考にして修正してください。

dot.scmail/deliver-rules.sample

#{../dot.scmail/deliver-rules.sample}

dot.scmail/refile-rules.sample

#{../dot.scmail/refile-rules.sample}

スパムフィルタの使い方

scbayesのドキュメントを参照してください

FAQ

巨大なファイルの処理は?

scmail はメールをすべてメモリ内で処理するため、メモリに入り きらない巨大なメールは処理できません。よって、scmail-deliver で巨大なメールをロストしてしまうことがあるかもしれません。

規則ファイルに文法エラーがあった場合は?

規則ファイルに括弧の閉じ忘れなどの文法エラーがあった場合、正 しく読み込めた部分だけが規則として用いられ、壊れた規則は無視 されます。文法エラーのメッセージは~/.scmail/log ファイルに記 録されます。

日本語の処理がうまくいきません

規則ファイルは Gauche の内部コードに合わせる必要があります。 Gauche の内部コードは次のコマンドで調べられます。

% gosh -e '(print (gauche-character-encoding))' -Eexit
euc-jp

ダウンロード

BSDライセンスに従ったフリーソフトウェアとして公開します。 完全に無保証です。

参考文献

関連リンク集

メーリングリスト

QuickML でメーリングリストを作りました。 参加するには次のようなメールを送ってください。

Subject: 参加します
To: scmail@quickml.com
Cc: satoru@namazu.org

(参加メッセージ)
Satoru Takabayashi
scmail-1.3.orig/doc/scmail.html.in0000644000175000017500000002001410101454213017574 0ustar gniibegniibe00000000000000 scmail: a mail filter written in Scheme

English | Japanese

scmail: a mail filter written in Scheme

Last Modified: 2004-07-27 (Since: 2002-10-24)

What's scmail?

scmail is a mail filter written in Scheme. scmail can filter an incoming mail when it is received and filter mails in a mailbox. A bayesian spam filter called scbayes is also included.

What's new?

Requirements

Characteristics

Installation

To install scmail, run the following commands.

% gzip -dc scmail-1.3.tar.gz | tar xvf - 
% cd scmail-1.3
Password: (enter root's password)
# make
# make install

Components

Configuration

Copy a sample file (~/dot.scmail/config.sample) to ~/.scmail/config and edit it.

#{../dot.scmail/config.sample}

Using scmail-deliver

scmail-deliver is a command to filter an incoming mail when it is received. scmail-deliver uses Filtering rules defined in ~/.scmail/deliver-rules. You can copy a sample file (dot.scmail/deliver-rules.sample) to ~/.scmail/deliver-rules.

If your mail server is Sendmail or Postfix, you can put the following ~/.forward file to filter an incoming mail when it is received.

| /usr/local/bin/scmail-deliver

If you are using fetchmail to fetch mails from a POP server, you can add the following code into your ~/.fetchmailrc file to use scmailrc-deliver.

poll pop3.example.org
     protocol apop
     user satoru
     mda "/usr/local/bin/scmail-deliver"
     no mimedecode

Using scmail-refile

scmail-refile is a command to filter mails in a mailbox. scmail-refile uses Filtering rules defined in ~/.scmail/refile-rules. You can copy a sample file (dot.scmail/refile-rules.sample) to ~/.scmail/refile-rules.

To use scmail-refile, run it on the command line like the following:

% scmail-refile
refile: inbox/93 -> ml/enkai@coboler/57
refile: inbox/94 -> ml/linux-zaurus/218
refile: inbox/98 -> ml/linux-zaurus/219
refile: inbox/99 -> ml/ming/42

In this example, the first line in the output messages shows a mail 93 in inbox folder is refiled to ml/enkai@colber as a mail 57. ~/.scmail/log file contains the same report with time information.

% tail -5 ~/.scmail/log
2002-09-26T12:49:31: refile: inbox/93 -> ml/enkai@coboler/57  
2002-09-26T12:49:31: refile: inbox/94 -> ml/linux-zaurus/218  
2002-09-26T12:49:31: refile: inbox/98 -> ml/linux-zaurus/219
2002-09-26T12:49:31: refile: inbox/99 -> ml/ming/42

Filtering rules

You can edit sample files.

dot.scmail/deliver-rules.sample

#{../dot.scmail/deliver-rules.sample}

dot.scmail/refile-rules.sample

#{../dot.scmail/refile-rules.sample}

Using a spam filter

Please see scbayes's documentation.

FAQ

How does scmail handle a huge mail?

Since scmail handles a mail on memory entirely, a huge mail which cannot fit in memory is not supported. So, scmail-deliver perhaps loses an incoming huge mail.

What happens if a rule file has syntax errors?

scmail uses rules read correctly and broken rules are ignored. Messages of syntax errors are reported in ~/.scmail/log.

Download

scmail is a free software with ABSOLUTELY NO WARRANTY under so called "BSD licence".

References

Links

Satoru Takabayashi
scmail-1.3.orig/doc/scbayes-ja.html0000644000175000017500000001706210101454256017760 0ustar gniibegniibe00000000000000 scbayes: scmail 用のベイジアンフィルタライブラリ

English | Japanese

scbayes: scmail 用のベイジアンフィルタライブラリ

最終更新日: 2004-07-27 (公開日: 2004-01-05)

Shiro Kawai (shiro@acm.org)

scbayesとは

Paul Grahamが提案した、ベイズ検定を用いてスパムフィルタリングを行う ツールです。理論的背景については、参考文献を参照して下さい。 scmailに組み込まれた形で動作します。また、学習や検証を行うために scbayesというスクリプトが用意してあります。

scmailでベイジアンフィルタを使うには、つぎの二つの準備が必要です。

学習

まず学習により確率テーブルを作る必要があります。 spamメールと正当なメールを別のフォルダに分けておいて下さい。 正当なメールを学習するには

% scbayes --learn-nonspam フォルダ ...

spamメールを学習するには

% scbayes --learn-spam フォルダ ...

とすれば、確率テーブルが作成されます。確率テーブルファイルは、 デフォルトでは ~/.scmail/ の下に作成されます。 ~/.scmail/config にてカスタマイズ可能です。既に確率テーブル がある場合はそれに追加されてゆきます。

例えば、正当なメールで保存するものが inbox-saveフォルダに、 spamメールが spamフォルダに、そしてspamではないがゴミとして 捨てたメールが trashフォルダにあるとすると、次のようにコマンド を実行します。

% scbayes --learn-nonspam inbox-save trash
% scbayes --learn-spam spam

筆者の手元の環境 (Pen4 2GHz) では15000通のspamを学習するのに 15分程かかりました。

なお、scbayesは既に学習したメールを記録しておくようになったので、 追加学習をする際には再び同じフォルダを指定すればOKです。 未学習のメールのみテーブルに追加します。

誤って学習させてしまったメールの影響を除きたい場合は、 --unlearn-spam、--unlearn-nonspam オプションを与えると、 指定フォルダに含まれるメールをすべて「忘れる」ことができます。

現在のところ、学習、学習の取消し共にフォルダ単位で扱います。 特定のメッセージのみ扱いたい場合は、それだけを別フォルダに移して 学習等を行って下さい。

scmailの設定

~/.scmail/refile-rules や ~/.scmail/deliver-rules 内に、

(add-bayesian-filter-rule!)

と書いておけば、scmail-refile/scmail-deliver が走った際にベ イジアンフィルタが適用され、spamと判定されたメールが"spam"と いうフォルダ (~/.scmail/config で設定できます) に送られます。

ルールは最初から順に適用されるので、(add-bayesian-filter-rule!)を 書く位置はフィルタリングの有効性に影響します。筆者の経験では、 身元がはっきりしているメールはベイジアンフィルタリングの前に 規則であらかじめ振り分けておき、残ったメールに対して ベイジアンフィルタリングを適用するのが効果が高いようです。

なお、lambda式でフィルタリングルールを書いている場合は、

(mail-is-spam? mail)

という式でspamかどうかの判定ができます。例えば次のように書くことができます。

(lambda (mail)
  (and (mail-is-spam? mail)
       (mail 'from #/\.kp\b/)
       (refile mail "spam-from-north-korea"))

Tips

学習に使うメールが少ないとあまり効果が出ないと思います。 「spamでは無いが捨てたメール」というのは貴重な情報源ですので、 nonspamの学習ソースとして取っておくと良いでしょう。

メールマガジン、オンラインショッピングのレシート、広告付き 無料メーリングリスト等はspam度が高くなりがちなので、ベイジアン フィルタでの判定を行う前にfromフィールド等で別フォルダに仕分けて 置くことを強くお奨めします。

scbayesのその他の機能

scbayesスクリプトには、他にいくつかの管理用機能が実装されています。

学習されたメール数および単語数を見るには、--table-statオプションを用います。

% scbayes --table-stat
lang       nonspam           spam
#t  :  184657w/ 3129m   453409w/14061m
jp  :   88720w/ 3834m    67379w/  813m
total: 273377w/ 6963m   520788w/14874m

langの項は、'#t' が非日本語メール、'jp' が日本語メール、'total' が合計です。 各行において、'w'の前の数字が学習された単語数、'm'の前の数字がメール数です。

scmailを通さずに特定のメールのspam度を調べたい場合は、--check-mail オプションにメールファイルを与えます (メールがひとつづつファイルとして 独立していることを仮定しています。) scbayesは、メールのspam度 および、その計算に寄与した「最も特徴的な単語」15個と各々のspam確率を 表示します。

% scbayes --check-mail ~/Mail/spam/13500
/home/shiro/Mail/spam/13500
  1.0
    wwww3 : 0.9999
    html4 : 0.9999
    style6 : 0.9999
    style5 : 0.9999
    discreetly : 0.9999
    delobel : 0.9999
    bastapharma : 0.9999
    meds : 0.9999
    estes : 0.9998
    overnight : 0.9685370077823972
    needed! : 0.9652974189631429
    medication : 0.9608080329456689
    prescription : 0.9600886615864224
    prescribed : 0.9578025262665094
    medications : 0.9520815441868073

scbayesによる判定そのものの統計をとりたい場合には、--check-spam, --check-nonspamオプションを使います。

% scbayes --check-spam folder

とすると、folderの中のメールを検査し、spamと判定されなかったメールの 総数および各々の単語の確率を出力します (それらのメールは、本来 spamであるのにフィルタをすり抜けたものと考えられます)。

% scbayes --check-nonspam folder

とすると、folderの中のメールを検査し、spamと判定されたメールの 総数および各々の単語の確率を出力します (それらのメールは、本来 nonspamであるのにspamと誤認識されたものと考えられます)。 あまりに誤認識が多い場合は、明示的なフィルタリングルール等を 組み合わせるといった対応が必要かもしれません。筆者の経験では、 ほとんどの場合、この検査は筆者自身の操作の誤りでnon-spamフォルダに 紛れ込んだspamを発見します。

scbayesの処理内容

scbayesはPaul Graham方式の素直な実装ですが、日本語に対応するために 以下の処理を行っています。

さらに詳しい内容に関しては、Gauche:SpamFilterのページを参照して下さい。

参考文献

scmail-1.3.orig/doc/scbayes.html0000644000175000017500000001774310101454232017370 0ustar gniibegniibe00000000000000 scbayes: a Bayesian filtering library for scmail

English | Japanese

scbayes: a Bayesian filtering library for scmail

Last Modified: 2004-07-27 (Since: 2004-01-09)

Shiro Kawai (shiro@acm.org)

What is scbayes?

Scbayes is a library for scmail that implements a Bayesian spam filter described in Paul Graham's "A Plan for Spam". It is bundled in scmail, and works within scmail. A separate script 'scbayes' is provided to manage the database.

To filter spams using Bayesian filtering within scmail, you have to take the following preparation steps.

Learning

First of all, you need to build a statistics table. You need to have separate folders for spams and non-spam mails. To learn non-spam mails, run scbayes as follows:

% scbayes --learn-nonspam folder ...

To learn spams, run scbayes as follows:

% scbayes --learn-spam folder ...

These command build a statistics table (under ~/.scmail/ by default; you can specify the location of the table by ~/.scmail/config). If you already have the table, the newly learned data is added to the table.

For example, suppose you have non-spam saved mails in the 'inbox-save' folder, and discarded (but non-spam) mails in the 'trash' folder, and spam mails in 'spam' folder. Then you can build the statistics table by the following commands.

% scbayes --learn-nonspam inbox-save trash
% scbayes --learn-spam spam

On the author's machine (Pentium 4, 2GHz), it took about 15minuets to learn 15000 spams.

Scbayes remembers the mails it learned, so you can run learning command again on the same folder to learn new mails that are added after the last time you ran the command.

If you make a mistake to learn mails in a wrong category, you can make them unlearned by --unlearn-spam and --unlearn-nonspam options. It makes scbayes 'forget' about all mails in the given folder(s).

For the time being, scmail can only deal with folders to learn/unlearn statistics. If you want to deal with a particular message, create a folder and move it to that folder, then run the command on the folder.

Configuring scmail

If you write 

(add-bayesian-filter-rule!)

in ~/.scmailrc/refile-rules and/or ~/.scmailrc/deliver-rules, scmail-refile/scmail-deliver applies bayesian filter to the message it is processing, and refiles it to the "spam" folder (you can specify the folder by ~/.scmail/config) if the message is determined as a spam.

Note that scmail applies rules in the order in the configuration file, so the location of (add-bayesian-filter-rule!) matters. I found that it worked well if I first applied explicit rules to refile emails from known senders, then applied the bayesian filter to the rest.

If you need to write a filtering rule in lambda expressions, you can use the predicate 'mail-is-spam?' to check whether the mail is spam or not. For example, you can write the following rule.

(lambda (mail)
  (and (mail-is-spam? mail)
       (mail 'from #/\.kp\b/)
       (refile mail "spam-from-north-korea"))

Tips

Bayesian filtering doesn't work well if you have too few mails to learn. The mails which are not a spam but you don't need, are also the source of learning, so you'd better keep them separately, e.g. in "trash" folder.

Some types of non-spam mails, such as periodical ad mails, or free mailing-list messages with an ad attached, may look suspiciously like spams statistically. A good strategy is to refile them by explicit rules before applying the bayesian filter.

Other features of scbayes

The "scbayes" script has a few other management features.

You can look a statistic information by --table-stat option.

% scbayes --table-stat
lang       nonspam           spam
#t  :  184657w/ 3129m   453409w/14061m
jp  :   88720w/ 3834m    67379w/  813m
total: 273377w/ 6963m   520788w/14874m

Each row shows the number of learned words and messages, for each category (nonspam/spam). "#t" row shows non-japanese messages, "jp" row shows japanese messages, and "total" row is the sum of them.

You can check a "spamness" of a particular message without running scmail. Use --check-mail option of scbayes. Scbayes will show the spam probability of the message, with the most significant words and their spam probabilities that contributes the spamness of the message.

% scbayes --check-mail ~/Mail/spam/13500
/home/shiro/Mail/spam/13500
  1.0
    wwww3 : 0.9999
    html4 : 0.9999
    style6 : 0.9999
    style5 : 0.9999
    discreetly : 0.9999
    delobel : 0.9999
    bastapharma : 0.9999
    meds : 0.9999
    estes : 0.9998
    overnight : 0.9685370077823972
    needed! : 0.9652974189631429
    medication : 0.9608080329456689
    prescription : 0.9600886615864224
    prescribed : 0.9578025262665094
    medications : 0.9520815441868073

If you want to know how accurate scbayes is, you can run it over the specific folder using --check-spam and --check-nonspam options.

% scbayes --check-spam folder

This scans all messages in folder, and reports messages that are not categorized as a spam. So if you run this on the spam folder, you can see how many messages scbayes would have failed to recognize as spams.

% scbayes --check-nonspam folder

This also scans the folder, but reports messages that are categorized as a spam. If you run this on the non-spam folder, you can check false positives. If you're getting too many false positives, start consider applying explicit rules to refile suspicious messages. In my experience, this check just shows the spams which ends up in the non-spam folders by my mis-operation.

What scbayes does

Scbayes is pretty straightforward implementation of Paul Graham's method. However, it does some special treatment on Japanese messages.

For further details, see Gauche:SpamFilter.

References

scmail-1.3.orig/scmail/0002755000175000017500000000000010101462373015547 5ustar gniibegniibe00000000000000scmail-1.3.orig/scmail/config.scm0000644000175000017500000001165110061102402017507 0ustar gniibegniibe00000000000000;;; ;;; scmail - a mail filter written in Scheme ;;; ;;; Copyright (C) 2002-2004 Satoru Takabayashi ;;; All rights reserved. ;;; This is free software with ABSOLUTELY NO WARRANTY. ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. ;;; (define-module scmail.config (use file.util) (use gauche.parameter) (export scmail-config-set-directory! scmail-config-default-file scmail-config-get-path scmail-config-make-directory scmail-config-read scmail-config scmail-config-set-verbose-mode! scmail-config-verbose-mode? )) (select-module scmail.config) (define scmail-config-directory (make-parameter (expand-path "~/.scmail"))) (define (scmail-config-set-directory! directory) (scmail-config-directory directory)) (define-class () ((mailbox :init-value "~/Mail" :init-keyword :mailbox) (mailbox-type :init-value 'mh :init-keyword :mailbox-type) (inbox :init-value "inbox" :init-keyword :inbox) (spam :init-value "spam" :init-keyword :spam) (umask :init-value #o077 :init-keyword :umask) (size-limit :init-value (* (* 1024 1024) 10) ; 10 MB :init-keyword :size-limit) (smtp-host :init-value "localhost" :init-keyword :smtp-host) (log-file :init-value "log" :init-keyword :log-file) (deliver-rules :init-value "deliver-rules" :init-keyword :deliver-rules) (refile-rules :init-value "refile-rules" :init-keyword :refile-rules) (token-table :init-value "token-table.dbm" :init-keyword :token-table) (digest :init-value "digest.dbm" :init-keyword :digest) (verbose-mode :init-value #f) ;; for backward compatibility (junk :init-value #f :init-keyword :junk) )) (define (build-config-path path) (if (absolute-path? path) path (build-path (scmail-config-directory) path))) (define-method initialize ((config ) initargs) (next-method) (if (not (or (eq? (ref config 'mailbox-type) 'mh) (eq? (ref config 'mailbox-type) 'maildir))) (errorf "unsupported mailbox-type: ~a" (ref config 'mailbox-type))) (if (ref config 'junk) (slot-set! config 'spam (ref config 'junk))) (for-each (lambda (slot) (slot-set! config slot (expand-path (ref config slot)))) (list 'log-file 'refile-rules 'deliver-rules 'mailbox 'token-table 'digest)) ) (define (scmail-config-read config-file) (with-error-handler (lambda (e) (make )) (lambda () (let ((options (call-with-input-file config-file (lambda (port) (read port))))) (scmail-config (apply make options)) (scmail-config))))) (define-method write-object ((config ) port) (format port "[config]")) (define scmail-config (make-parameter (make ))) (define (scmail-config-set-verbose-mode!) (slot-set! (scmail-config) 'verbose-mode #t)) (define (scmail-config-verbose-mode?) (ref (scmail-config) 'verbose-mode)) ;; Return an old path if it is existed for backward compatibility. (define (choose path) (define table (map (lambda (pair) (cons (build-config-path (car pair)) (expand-path (cdr pair)))) '(("config" . "~/.scmailrc") ("refile-rules" . "~/.scmailrc-refile") ("deliver-rules" . "~/.scmailrc-deliver")))) (let* ((new-path (expand-path path)) (old-path (let1 pair (assoc new-path table) (if pair (expand-path (cdr pair)) #f)))) (if (and old-path (not (file-exists? new-path)) (file-exists? old-path)) old-path new-path))) (define (scmail-config-default-file) (choose (build-config-path "config"))) (define (scmail-config-get-path slot) (choose (build-config-path (ref (scmail-config) slot)))) (define (scmail-config-make-directory) (let1 path (scmail-config-directory) (unless (file-exists? path) (with-error-handler (lambda (e) (scmail-eformat "~a" (ref e 'message))) (lambda () (create-directory* path)))) (if (file-exists? path) (begin (unless (file-is-directory? path) (scmail-eformat "~a is not a directory")) (unless (file-is-writable? path) (scmail-eformat "~a is not writable")))) )) (provide "scmail/config") scmail-1.3.orig/scmail/mail.scm0000644000175000017500000002130110101214756017170 0ustar gniibegniibe00000000000000;;; ;;; scmail - a mail filter written in Scheme ;;; ;;; Copyright (C) 2002-2004 Satoru Takabayashi ;;; All rights reserved. ;;; This is free software with ABSOLUTELY NO WARRANTY. ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. ;;; (define-module scmail.mail (use srfi-1) (use srfi-13) (use gauche.charconv) (use gauche.regexp) (use gauche.parameter) (use rfc.822) (use rfc.base64) (use rfc.quoted-printable) (use gauche.net) (use file.util) (use scmail.util) (export make-scmail-mail scmail-mail-removed? scmail-mail-query scmail-mail-write scmail-mail-remove scmail-mail-forward scmail-mail-rename scmail-mail-from-stdin? scmail-mail-decode-field scmail-send-mail scmail-mail-copy scmail-mail-move scmail-mail-prepare scmail-mail-add-type!)) (select-module scmail.mail) (define-class () ((port :init-form (current-input-port)) (file :init-value #f :init-keyword :file) (content :init-value "") (info :init-value '()) (dry-run-mode :init-keyword :dry-run-mode :init-value #f) (removed? :init-value #f))) (define-method initialize ((mail ) initargs) (next-method) (if (ref mail 'file) (slot-set! mail 'port (open-input-file (ref mail 'file)))) (scmail-mail-read mail (symbol->string (gauche-character-encoding)))) (define-method write-object ((mail ) port) (format port "~a" (class-name (class-of mail)))) (define-method scmail-mail-read ((mail ) to-code) (define (add-info! key value) (slot-set! mail 'info (cons (cons key value) (ref mail 'info)))) ;; We don't know which character code the mail is written in beforehand. ;; For safety, we use block I/O to read the mail. (define (read-content iport) (when (eq? iport (standard-input-port)) (set! (port-buffering iport) :none)) (let loop ((block "") (blocks '())) (if (eof-object? block) (string-concatenate-reverse blocks) (loop (read-block 4096 iport) (cons block blocks))))) ;; decode the value of a field. (define (read-header cport) (map (lambda (field) (let ((name (first field)) (value (second field))) (list name (scmail-mail-decode-field value to-code)))) (rfc822-header->list cport))) ;; First we read everything into content. (set! (ref mail 'content) (read-content (ref mail 'port))) (close-input-port (ref mail 'port)) ;; Parse the content (unless (string-null? (ref mail 'content)) (call-with-input-string (ref mail 'content) (lambda (cport) (let1 headers (read-header cport) (set! (ref mail 'info) (map (lambda (p) (cons (string->symbol (car p)) (cadr p))) (filter (lambda (p) (and (string? (car p)) (string? (cadr p)))) headers))) (add-info! 'body (get-remaining-input-string cport)) (add-info! 'length (string-size (ref mail 'content))) (add-info! 'to/cc (string-append (scmail-mail-query mail 'to) ", " (scmail-mail-query mail 'cc))) (add-info! 'file (or (ref mail 'file) "(stdin)")) ;; for backward compatibility. (add-info! 'file-name (port-name (ref mail 'port))) ))))) (define-method scmail-mail-query ((mail ) key . options) (cond ((null? options) (let ((pair (assq key (ref mail 'info)))) (if pair (cdr pair) ""))) ((eq? (car options) :multi-field) (map cdr (filter (lambda (pair) (eq? key (car pair))) (ref mail 'info)))))) (define-method scmail-mail-port ((mail )) (open-input-string (ref mail 'content))) (define-method scmail-mail-from-stdin? ((mail )) (eq? (ref mail 'file) #f)) (define-method scmail-mail-removed? ((mail )) (ref mail 'removed?)) (define-method scmail-mail-dry-run-mode? ((mail )) (ref mail 'dry-run-mode)) (define-method scmail-mail-write ((mail ) file) (unless (scmail-mail-dry-run-mode? mail) (call-with-output-file file (lambda (port) (copy-port (scmail-mail-port mail) port))))) (define-method scmail-mail-remove ((mail )) (unless (or (scmail-mail-from-stdin? mail) (scmail-mail-dry-run-mode? mail)) (sys-unlink (scmail-mail-query mail 'file))) (slot-set! mail 'removed? #t)) (define-method scmail-mail-rename ((mail ) new-name) (unless (scmail-mail-dry-run-mode? mail) (sys-rename (scmail-mail-query mail 'file) new-name)) (slot-set! mail 'removed? #t)) (define-method scmail-mail-forward ((mail ) host address) (unless (scmail-mail-dry-run-mode? mail) (scmail-send-mail host 25 (scmail-mail-port mail) "" address))) ;; (scmail-mail-decode-field ;; "=?iso-2022-jp?Q?=1B=24=42=24=22=1B=28=42?=abc" "eucjp") ;; => "$B$"(Babc" ;; (scmail-mail-decode-field "=?ISO-2022-JP?B?GyRCJCIbKEJhYmM=?=" "eucjp") ;; => "$B$"(Babc" (define (scmail-mail-decode-field str to-code) (with-error-handler (lambda (e) str) (lambda () (regexp-replace-all #/=\?([^?]+)\?([BQ])\?([^?]+)\?=\s*/ str (lambda (m) (let* ((charcode (rxmatch-substring m 1)) (encoding (rxmatch-substring m 2)) (message (rxmatch-substring m 3)) (decode (if (equal? encoding "B") base64-decode-string quoted-printable-decode-string))) (ces-convert (decode message) charcode to-code))))))) ;; (scmail-send-mail "localhost" 25 (open-input-string "Hello!") ;; "from@localhost" "to@localhost") (define (scmail-send-mail host port iport mail-from recipients) (with-error-handler (lambda (e) (errorf "scmail-send-mail failed: ~a" (ref e 'message))) (lambda () (call-with-client-socket (make-client-socket 'inet host port) (lambda (in out) (let ((send-command (lambda (command code) (when command (format out "~a\r\n" command)) (let* ((line (read-line in)) (return-code (string->number (substring line 0 3)))) (if (eq? return-code code) line (errorf "smtp-error: ~a => ~a" command line)))))) (send-command #f 220) (send-command (format "HELO ~a" (sys-gethostname)) 250) (send-command (format "MAIL FROM: <~a>" mail-from) 250) (for-each (lambda (rcpt) (send-command (format "RCPT TO: <~a>" rcpt) 250)) (if (string? recipients) (list recipients) recipients)) (send-command "DATA" 354) (port-for-each (lambda (line) (format out "~a~a\r\n" (if (string-prefix? "." line) "." "") line)) (lambda () (read-line iport #t))) (send-command "." 250) (send-command "QUIT" 221)))) #t))) (define supported-mail-type-table (make-parameter '())) (define (scmail-mail-add-type! name class) (supported-mail-type-table (cons (cons name class) (supported-mail-type-table)))) (define (make-scmail-mail mail-type . options) (let1 pair (assq mail-type (supported-mail-type-table)) (if pair (apply make (cdr pair) options) (errorf "unsupported mail-type: ~a" mail-type)))) (define-method scmail-mail-copy ((mail ) folder) (scmail-not-implemented-error mail 'scmail-mail-copy)) (define-method scmail-mail-prepare ((mail ) folder) (scmail-not-implemented-error mail 'scmail-mail-prepare)) (define-method scmail-mail-move ((mail ) folder) (let1 new-name (scmail-mail-prepare mail folder) (scmail-mail-rename mail new-name) new-name)) (provide "scmail/mail") scmail-1.3.orig/scmail/mailbox.scm0000644000175000017500000000405710061102402017677 0ustar gniibegniibe00000000000000;;; ;;; scmail - a mail filter written in Scheme ;;; ;;; Copyright (C) 2002-2004 Satoru Takabayashi ;;; All rights reserved. ;;; This is free software with ABSOLUTELY NO WARRANTY. ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. ;;; (define-module scmail.mailbox (use srfi-1) (use file.util) (use gauche.parameter) (export make-scmail-mailbox scmail-mailbox-mail-list scmail-mailbox-make-folder scmail-mailbox-folder->path scmail-mailbox-add-type! )) (select-module scmail.mailbox) (define-class () ((location :init-value #f :init-keyword :location))) (define-method scmail-mailbox-mail-list ((mailbox ) folder) (scmail-not-implemented-error mailbox 'scmail-mailbox-mail-list)) (define-method scmail-mailbox-make-folder ((mailbox ) folder) (let1 dest-directory (scmail-mailbox-folder->path mailbox folder) (create-directory* dest-directory) dest-directory)) (define-method scmail-mailbox-folder->path ((mailbox ) folder) (build-path (ref mailbox 'location) folder)) (define supported-mailbox-type-table (make-parameter '())) (define (scmail-mailbox-add-type! name class) (supported-mailbox-type-table (cons (cons name class) (supported-mailbox-type-table)))) (define (make-scmail-mailbox mailbox-type location) (let1 pair (assq mailbox-type (supported-mailbox-type-table)) (if pair (make (cdr pair) :location location) (errorf "unsupported mailbox-type: ~a" mailbox-type)))) (provide "scmail/mailbox") scmail-1.3.orig/scmail/maildir.scm0000644000175000017500000001037610101220053017664 0ustar gniibegniibe00000000000000;;; ;;; scmail - a mail filter written in Scheme ;;; ;;; Copyright (C) 2002-2004 Satoru Takabayashi ;;; All rights reserved. ;;; This is free software with ABSOLUTELY NO WARRANTY. ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. ;;; (define-module scmail.maildir (use srfi-1) (use file.util) (use scmail.mail) (use scmail.mailbox) ) (select-module scmail.maildir) ;; ;; mailbox object ;; (define-class () ()) (define-method scmail-mailbox-mail-list ((mailbox ) folder) (let1 directory (scmail-mailbox-folder->path mailbox folder) (if (file-is-directory? directory) (apply append (map (lambda (subdir) (let ((directory (build-path directory subdir))) (sort (filter (lambda (x) (and (file-is-regular? x) (file-is-readable? x))) (directory-list directory :add-path? #t :children? #t :filter #/^[0-9]+/))))) (list "cur" "new"))) '()))) (scmail-mailbox-add-type! 'maildir ) ;; ;; mail object ;; (define-class () ((mailbox :init-value #f :init-keyword :mailbox))) (define-method maildir-get-subdir ((mail )) (if (or (scmail-mail-from-stdin? mail) (string=? "new" (sys-basename (sys-dirname (scmail-mail-query mail 'file))))) "new" "cur")) (define-method scmail-mail-prepare ((mail ) folder) (let* ((mailbox (ref mail 'mailbox)) (dest-directory (scmail-mailbox-make-folder mailbox folder)) (new-id (if (or (eq? mail #f) (scmail-mail-from-stdin? mail)) (maildir-generate-new-id) (sys-basename (scmail-mail-query mail 'file)))) (subdir (if mail (maildir-get-subdir mail) "new")) (new-file (string-append (maildir-file new-id dest-directory subdir)))) (maildir-make-sub-directories dest-directory) (if (file-exists? new-file) (errorf "scmail-mail-prepare: ~a already exists" new-file)) new-file)) (define-method scmail-mail-copy ((mail ) folder) (let1 new-file (scmail-mail-prepare mail folder) (if (equal? folder "") ;; the top of ~/Maildir (maildir-safe-write-mail new-file (lambda (file) (scmail-mail-write mail file))) (begin (scmail-mail-write mail new-file) new-file)))) (define (maildir-safe-write-mail new-file write-proc) (let* ((timer 30) (id (sys-basename new-file)) (tmp-file (build-path (sys-dirname (sys-dirname new-file)) "tmp" id))) (while (file-exists? tmp-file) (if (<= timer 0) (errorf "maildir-safe-write-mail timeout!")) (sys-sleep 2) (set! timer (- timer 2))) (write-proc tmp-file) (sys-link tmp-file new-file) (sys-unlink tmp-file) new-file)) (define (maildir-make-sub-directories directory) (create-directory* (build-path directory "tmp")) (create-directory* (build-path directory "cur")) (create-directory* (build-path directory "new"))) (define maildir-generate-new-id (let1 maildir-seq 0 (lambda () (inc! maildir-seq) (format "~a.~a_~a.~a" (sys-time) (sys-getpid) maildir-seq (sys-gethostname))))) (define (maildir-file id directory subdir) (build-path directory subdir id)) (scmail-mail-add-type! 'maildir ) (provide "scmail/maildir") scmail-1.3.orig/scmail/mh.scm0000644000175000017500000000616310061102402016650 0ustar gniibegniibe00000000000000;;; ;;; scmail - a mail filter written in Scheme ;;; ;;; Copyright (C) 2002-2004 Satoru Takabayashi ;;; All rights reserved. ;;; This is free software with ABSOLUTELY NO WARRANTY. ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. ;;; (define-module scmail.mh (use srfi-1) (use file.util) (use scmail.mail) (use scmail.mailbox) ) (select-module scmail.mh) ;; ;; mailbox object ;; (define-class () ()) (define-method scmail-mailbox-mail-list ((mailbox ) folder) (let1 directory (scmail-mailbox-folder->path mailbox folder) (if (file-is-directory? directory) (map (lambda (id) (build-path directory (number->string id))) (sort (map string->number (filter (lambda (x) (let1 y (build-path directory x) (and (file-is-regular? y) (file-is-readable? y)))) (directory-list directory :children? #t :filter #/^[0-9]+$/))))) '()))) (scmail-mailbox-add-type! 'mh ) ;; ;; mail object ;; (define-class () ((mailbox :init-value #f :init-keyword :mailbox))) ;; (mh-file 123 "~/Mail/inbox") => "/home/foobar/Mail/inbox/123" (define (mh-file id directory) (build-path directory (number->string id))) ;; for dry-run mode. (define mh-dry-run-last-id (let1 id-table (make-hash-table 'string=?) (lambda (directory) (let1 id (hash-table-get id-table directory 0) (hash-table-put! id-table directory (+ id 1)) id)))) ;; (mh-last-mail-id "~/Mail/inbox") => 8 (define-method mh-last-mail-id ((mail ) folder) (let1 mailbox (ref mail 'mailbox) (if (file-is-directory? (scmail-mailbox-folder->path mailbox folder)) (let ((mlist (scmail-mailbox-mail-list mailbox folder))) (if (null? mlist) 0 (string->number (sys-basename (car (last-pair mlist)))))) (mh-dry-run-last-id folder)))) (define-method scmail-mail-prepare ((mail ) folder) (let* ((mailbox (ref mail 'mailbox)) (dest-directory (scmail-mailbox-make-folder mailbox folder)) (new-id (+ 1 (mh-last-mail-id mail folder)))) (mh-file new-id dest-directory))) (define-method scmail-mail-copy ((mail ) folder) (let1 new-file (scmail-mail-prepare mail folder) (scmail-mail-write mail new-file) new-file)) (scmail-mail-add-type! 'mh ) (provide "scmail/mh") scmail-1.3.orig/scmail/progress.scm0000644000175000017500000001305710061102402020110 0ustar gniibegniibe00000000000000;;; ;;; scmail - a mail filter written in Scheme ;;; ;;; Copyright (C) 2002-2004 Satoru Takabayashi ;;; All rights reserved. ;;; This is free software with ABSOLUTELY NO WARRANTY. ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. ;;; (define-module scmail.progress (use srfi-13) (use srfi-19) (export progress-finish! progress-inc!)) (select-module scmail.progress) (define-class () ((title :init-value "progress" :init-keyword :title) (total :init-value 100 :init-keyword :total) (port :init-form (current-output-port) ;; not init-value!! :init-keyword :port) (title-width :init-value 10) (bar-width :init-value 44) (bar-mark :init-value #\o :init-keyword :bar-mark) (current :init-value 0) (previous :init-value 0) (finished? :init-value #f) (previous-time) (start-time))) (define (time-difference->real time0 time1) (let1 time (time-difference time0 time1) (+ (time-second time) (/ (time-nanosecond time) 1000000000)))) (define-method initialize ((progress ) initargs) (next-method) (slot-set! progress 'start-time (current-time)) (slot-set! progress 'previous-time (ref progress 'start-time)) (set! (port-buffering (ref progress 'port)) :none) (show progress)) (define-method write-object ((progress ) port) (format port "[progress]")) (define (format-time t) (let* ((t (round t)) (sec (modulo t 60)) (min (modulo (round (/ t 60)) 60)) (hour (/ t 3600))) (format #f "~2,'0d:~2,'0d:~2,'0d" (round hour) (round min) (round sec)))) (define-method eta ((progress )) (if (zero? (ref progress 'current)) "ETA: --:--:--" (let* ((elapsed (time-difference->real (current-time) (ref progress 'start-time))) (eta (round (- (/ (* elapsed (ref progress 'total)) (ref progress 'current)) elapsed)))) (format #f "ETA: ~a" (format-time eta))))) (define-method elapsed ((progress )) (let1 elapsed (time-difference->real (current-time) (ref progress 'start-time)) (format #f "Time: ~a" (format-time elapsed)))) (define-method stat ((progress )) (if (ref progress 'finished?) (elapsed progress) (eta progress))) (define-method eol ((progress )) (if (ref progress 'finished?) "\n" "\r")) (define-method bar ((progress )) (let1 len (round (/ (* (percentage progress) (ref progress 'bar-width)) 100)) (format #f "|~a~a|" (string-tabulate (lambda (i) (ref progress 'bar-mark)) len) (string-tabulate (lambda (i) #\ ) (- (ref progress 'bar-width) len))))) (define-method percentage ((progress )) (if (zero? (ref progress 'total)) 100 (round (/ (* (ref progress 'current) 100) (ref progress 'total))))) (define-method title ((progress )) (string-append (substring (ref progress 'title) 0 (min (- (ref progress 'title-width) 1) (string-length (ref progress 'title)))) ":")) (define-method show ((progress )) (let1 line (format #f #`"~,(ref progress 'title-width)a ~3d% ~a ~a " (title progress) (percentage progress) (bar progress) (stat progress)) (display line (ref progress 'port)) (display (eol progress) (ref progress 'port)) (slot-set! progress 'previous-time (current-time)) )) (define-method show-progress ((progress )) (let ((current-percentage (if (zero? (ref progress 'total)) 100 (/ (* (ref progress 'current) 100) (ref progress 'total)))) (previous-percentage (if (zero? (ref progress 'total)) 0 (/ (* (ref progress 'previous) 100) (ref progress 'total))))) (if (or (> (round current-percentage) (round previous-percentage)) (>= (time-difference->real (current-time) (ref progress 'previous-time)) 1.0) ;; 1 sec. elapsed. (ref progress 'finished?)) (show progress)))) (define-method progress-finish! ((progress )) (slot-set! progress 'current (ref progress 'total)) (slot-set! progress 'finished? #t) (show-progress progress)) (define-method progress-inc! ((progress ) . step) (let1 step (get-optional step 1) (slot-set! progress 'current (+ (ref progress 'current) step)) (if (> (ref progress 'current) (ref progress 'total)) (slot-set! progress 'current (ref progress 'total))) (show-progress progress) (slot-set! progress 'previous (ref progress 'current)))) (provide "scmail/progress") scmail-1.3.orig/scmail/util.scm0000644000175000017500000000536110101220137017221 0ustar gniibegniibe00000000000000;;; ;;; scmail - a mail filter written in Scheme ;;; ;;; Copyright (C) 2002-2004 Satoru Takabayashi ;;; All rights reserved. ;;; This is free software with ABSOLUTELY NO WARRANTY. ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. ;;; (define-module scmail.util (use file.util) (use srfi-13) (use gauche.parameter) (use scmail.config) (use scmail.progress) (use gauche.version) (export filter safe-rxmatch scmail-check-gauche-version scmail-set-program-name! scmail-wformat scmail-eformat scmail-dformat scmail-not-implemented-error )) (select-module scmail.util) ;; ;; FIXME: Reinvent it because filter in srfi-1 module is too ;; slow in old Gauche implementations. ;; (define (filter predicate items) (let loop ((result '()) (items items)) (cond ((null? items) (reverse! result)) ((predicate (car items)) (loop (cons (car items) result) (cdr items))) (else (loop result (cdr items)))))) ;;; For avoiding errors while handling incomplete string (define (safe-rxmatch pattern string) (with-error-handler (lambda (e) #f) (lambda () (rxmatch pattern string)))) (define program-name (make-parameter #f)) (define (scmail-set-program-name! name) (program-name (sys-basename name))) (define (scmail-xformat fmt . args) (if (program-name) (format (standard-error-port) "~a: " (program-name))) (apply format (standard-error-port) fmt args) (unless (eq? (string-ref fmt (- (string-length fmt) 1)) #\newline) (newline (standard-error-port)))) ;; for warnings (define (scmail-wformat fmt . args) (apply scmail-xformat fmt args)) ;; for errors (define (scmail-eformat fmt . args) (apply scmail-xformat fmt args) (exit 1)) ;; for debugging (verbose mode) (define (scmail-dformat fmt . args) (if (scmail-config-verbose-mode?) (apply scmail-xformat (string-append "debug: " fmt) args))) (define (scmail-check-gauche-version) (let1 required-version "0.7.4.1" (if (version) ;; should be customizable (define (token-table-special-key-prefix) " %") (define-constant *message-count-key* (string-append (token-table-special-key-prefix) "message-count")) (define (token-table-languages) '(#t ja)) (define (token-table-number-of-values) (* (length (token-table-languages)) 2)) (define-constant *value-packer* (make-string (token-table-number-of-values) #\V)) (define-class () ((db :init-keyword :db) (rwmode :init-keyword :rwmode) (cache :initform (make-hash-table 'string=?)) (message-count :init-keyword :message-count) )) (define (pack-value v) (pack *value-packer* (vector->list v) :to-string? #t)) (define (unpack-value s) (list->vector (unpack *value-packer* :from-string s))) (define (open-token-table file rwmode) (define (get-values db key) (cond ((dbm-get db key #f) => unpack-value) (else (make-vector (token-table-number-of-values) 0)))) (let* ((db (dbm-open *dbm-class* :path file :rw-mode rwmode)) (mcount (get-values db *message-count-key*))) (make :db db :rwmode rwmode :message-count mcount))) (define (minus->zero val) (max 0 val)) ;; FIXME: Making a huge list just to count is too wild. (define (token-table-cache-length) (length (hash-table-keys (ref (token-table) 'cache)))) (define (token-table-cache-flush . proc) (let ((proc (get-optional proc (lambda (counter) #t))) (counter 1)) (unless (and (memv (ref (token-table) 'rwmode) '(:write :create)) (not (dbm-closed? (ref (token-table) 'db)))) (errorf "token table is not writable or opened")) (hash-table-for-each (ref (token-table) 'cache) (lambda (k v) (let* ((s (dbm-get (ref (token-table) 'db) k #f)) (newv (map-to minus->zero (if s (map-to + v (unpack-value s)) v)))) (if (every zero? (vector->list newv)) (dbm-delete! (ref (token-table) 'db) k) (dbm-put! (ref (token-table) 'db) k (pack-value newv))) (proc counter) (inc! counter)))) (slot-set! (token-table) 'cache (make-hash-table 'string=?)) (for-each (lambda (key slot) (dbm-put! (ref (token-table) 'db) key (pack-value (map-to minus->zero (ref (token-table) slot))))) (list *message-count-key*) (list 'message-count)))) (define (close-token-table tab) (dbm-close (ref tab 'db)) (token-table #f)) (define token-table (make-parameter #f)) (define (with-token-table file rwmode thunk) ;; NB: this should really be an unwind-protect. ;; Waiting for its implementation... (dynamic-wind (lambda () (token-table (open-token-table file rwmode))) thunk (lambda () (close-token-table (token-table))))) ;; Open token table for reading. ;; We keep the name for backward compatibility. (define (load-prob-tables file) #t) (define (load-token-table-if-not-loaded) (let1 file (scmail-config-get-path 'token-table) (if (or (not (token-table)) (dbm-closed? (ref (token-table) 'db))) (let1 realfile (cond ((string-suffix? ".dbm" file) file) ((file-exists? #`",|file|.dbm") #`",|file|.dbm") ((string=? (string-complete->incomplete (with-input-from-file file (cut read-block 10))) #*";;-*-Schem") (errorf "Database file ~s seems to have an old format. Run scbayes --update-db" file)) (else file)) (if (file-exists? realfile) (token-table (open-token-table realfile :read))))))) (define (process-token type token sign . maybe-count) (let ((tab (token-table)) (cnt (get-optional maybe-count 1))) (or (and-let* ((v (hash-table-get (ref tab 'cache) token #f))) (inc! (ref v type) (sign cnt))) (let1 v (make-vector (token-table-number-of-values) 0) (inc! (ref v type) (sign cnt)) (hash-table-put! (ref tab 'cache) token v) )) )) (define (add-token type token . maybe-count) (apply process-token type token + maybe-count)) (define (delete-token type token . maybe-count) (apply process-token type token - maybe-count)) (define (token-count type token) (let* ((tab (token-table)) (v (or (hash-table-get (ref tab 'cache) token #f) (and-let* ((s (dbm-get (ref tab 'db) token #f)) (v (unpack-value s))) (hash-table-put! (ref tab 'cache) token v) v)))) (if v (ref v type) 0))) (define (message-count-of-type type) (ref (ref (token-table) 'message-count) type)) (set! (setter message-count-of-type) (lambda (type val) (set! (ref (ref (token-table) 'message-count) type) val))) ;; get appropriate table type index (define (token-table-index-of-spam lang) (+ (* (or (find-index (cut eqv? <> lang) (token-table-languages)) 0) 2) 1)) (define (token-table-index-of-nonspam lang) (* (or (find-index (cut eqv? <> lang) (token-table-languages)) 0) 2)) ;; for backward compatibility. ;; Convert old database to new database (define (convert-database old-path new-path) (define current-table #f) (with-input-from-file old-path (lambda () (with-token-table new-path :create (lambda () (port-for-each (lambda (expr) (if (keyword? (car expr)) (let1 tab ((if (get-keyword :spam? expr) token-table-index-of-spam token-table-index-of-nonspam) (get-keyword :lang expr)) (set! (message-count-of-type tab) (get-keyword :message-count expr)) (set! current-table tab)) (add-token current-table (car expr) (cdr expr)))) read))))) ) (define (token-table-token-count) (let1 result (make-vector (token-table-number-of-values) 0) (dbm-for-each (ref (token-table) 'db) (lambda (k v) (let1 v (unpack-value v) (unless (string-prefix? (token-table-special-key-prefix) k) (dolist (lang (token-table-languages)) (dolist (table (list token-table-index-of-nonspam token-table-index-of-spam)) (if (> (ref v (table lang)) 0) (inc! (ref result (table lang)))))))))) result)) (define (token-table-message-count) (ref (token-table) 'message-count)) (define (token-table-for-each proc) (dbm-for-each (ref (token-table) 'db) (lambda (k v) (let1 v (unpack-value v) (proc k v))))) ;;========================================================== ;; Collecting statistics ;; (define word-probability-limit 0.0001) (define (process-words mail table-getter process-token sign) (receive (tokens lang) (tokenize-email mail) (unless (null? tokens) (let1 tab (table-getter lang) (for-each (cut process-token tab <>) tokens) (inc! (message-count-of-type tab) (sign 1)))))) (define (token-table-collect-words mail table-getter) (process-words mail table-getter add-token +)) (define (token-table-discard-words mail table-getter) (process-words mail table-getter delete-token -)) ;; Calculate a word's spam probability. ;; Cf. Paul Graham, "A Plan for Spam" and "Better Bayesian Filtering" (define (spamness-of-word word lang) (load-token-table-if-not-loaded) (let* ((gtab (token-table-index-of-nonspam lang)) (btab (token-table-index-of-spam lang)) (g (token-count gtab word)) (b (token-count btab word)) (min-p word-probability-limit) (min-p2 (* min-p 2))) (cond ((< (+ (* g 2) b) 5) 0.4) ; default 'spamness' for unfamiliar word ((zero? g) (if (> b 10) (- 1 min-p) (- 1 min-p2))) ;see "Better" paper ((zero? b) (if (> g 10) min-p min-p2)) ;see "Better" paper (else (clamp (/ (clamp (/ b (message-count-of-type btab)) #f 1.0) (+ (clamp (/ (* g 2) (message-count-of-type gtab)) #f 1.0) (clamp (/ b (message-count-of-type btab)) #f 1.0))) min-p2 (- 1 min-p2))) ))) ;; Given list of probabilities, calculates combined probability ;; using Bayesian probability. (define (spam-probability probs) (let1 prod (apply * probs) (/ prod (+ prod (apply * (map (cut - 1 <>) probs)))))) ;; Take NUM most-interesting words from the list of tokens. (define (most-interesting-words lang tokens num) (let ((tab (make-hash-table 'string=?)) (extremeness (lambda (prob) (abs (- 0.5 prob))))) (for-each (lambda (tok) (unless (hash-table-get tab tok #f) (hash-table-put! tab tok (spamness-of-word tok lang)))) tokens) (let ((wlist (sort (hash-table-map tab cons) (lambda (a b) (> (extremeness (cdr a)) (extremeness (cdr b))))))) (take* wlist num)))) ;; Calculate probability of the mail being spam. Returns three values: ;; the probability, the language of the mail, and the list of 15 ;; significant words with each "spamness". (define (spamness-of-mail mail) (load-token-table-if-not-loaded) (receive (tokens lang) (tokenize-email mail) (let1 words (most-interesting-words lang tokens 15) (values (spam-probability (map cdr words)) lang words)))) ;; Predicate API (define (mail-is-spam? mail) (load-token-table-if-not-loaded) (and (token-table) (receive (prob lang words) (if (string? mail) ; Accept file name for backward compatibility (spamness-of-mail (make :file mail)) (spamness-of-mail mail)) (>= prob 0.9)))) ;;============================================================ ;; Tokenizing message ;; ;; Entry point. Reads FILE and returns two values; the list of ;; tokens and the language of the message. ;; First it tries to honor the charset in the message body ;; (if no charset is given, try to use "*ja" guessing), and if ;; it fails, re-try with us-ascii. ;; (Because of retry, we need to accumulate tokens instead of ;; processing them as we read FILE.) (define (tokenize-email mail) (define (try charset) (let* ((tokens '()) (lang (with-input-from-string (ref mail 'content) (cut with-port-locking (current-input-port) (cut tokenize-message (scmail-mail-query mail 'file) charset (lambda (token) (push! tokens token)))))) ) (values (reverse! tokens) lang))) (with-error-handler (lambda (e) (scmail-wformat "error during processing ~a (~a)" (scmail-mail-query mail 'file) (ref e 'message)) (values '() #f)) (lambda () (with-error-handler (lambda (e) (try "none")) (lambda () (try #f))))) ) ;; Tokenize one chunk of message (header + body). If the body is ;; MIME, call tokenize-mime, which in turn calls tokenise-message ;; recursively to deal with each part. Returns a language tag ;; (for now, either #t or 'ja). (define (tokenize-message file charset receiver) (let* ((headers (rfc822-header->list (current-input-port))) (content-type (get-content-type headers)) (boundary (get-mime-boundary content-type)) (charset (if (equal? charset "none") "none" (get-charset content-type charset))) ) (tokenize-header headers charset receiver) (if boundary (tokenize-mime file receiver charset boundary) (tokenize-body file receiver charset content-type (get-transfer-encoding headers))) )) ;; Tokenize a message header. Returns void. ;; NB: we should use tokenize-port-iso8859 in case if the header ;; contains invalid multibyte character. Right now, this code fails ;; when, for example, the mail has some invalid charset name and the ;; header field contains iso8859-1 character. However, such an error ;; is caught by tokenize-email and it rescans the mail by setting ;; charset to "us-ascii" forcibly, so such an email is correctly ;; parsed using tokenize-port-iso8859 eventually. (define (tokenize-header headers charset receiver) (for-each (lambda (header) (with-input-from-string (scmail-mail-decode-field (string-join (map x->string (cdr header)) " ") (x->string (gauche-character-encoding))) (cute (if (or (equal? "none" charset) (string-ci=? "us-ascii" charset) (string-prefix-ci? "iso-8859" charset)) tokenize-port-iso8859 tokenize-port) receiver))) headers)) ;; Tokenize a message body. ;; Returns a language tag, or #f. (define (tokenize-body file receiver charset content-type transfer-encoding) (define (do-tokenize) (cond ;; Lots of emails that claims charset=us-ascii actually contains ;; iso-8859 characters. ((or (equal? "none" charset) (string-ci=? "us-ascii" charset) (string-prefix-ci? "iso-8859" charset)) (tokenize-port-iso8859 receiver)) ;; Deal with multibyte messages. ((or (equal? charset "*ja") (ces-conversion-supported? charset (x->string (gauche-character-encoding)))) (with-input-from-port (open-input-conversion-port (current-input-port) charset) (cut tokenize-port receiver))) (else (scmail-dformat "~a: unknown charset (~a): applying single-byte analysis" file charset) (tokenize-port-iso8859 receiver)) )) (cond ((and content-type (not (or (string-prefix-ci? "text/" content-type) (string-prefix-ci? "message/rfc822" content-type)))) (scmail-dformat "skipping ~a (content-type=~a)" file content-type) #f) ((and transfer-encoding (string-ci=? transfer-encoding "base64")) (with-input-from-string (base64-decode-string (port->string (current-input-port))) do-tokenize)) ((and transfer-encoding (string-ci=? transfer-encoding "quoted-printable")) (with-input-from-string (quoted-printable-decode-string (port->string (current-input-port))) do-tokenize)) (else (do-tokenize)) )) ;; Tokenize MIME message. Calls tokenize-message for each part. ;; Returns a language tag, or #f. (define (tokenize-mime file receiver charset boundary) ;; skip the toplevel part (define (skip-preamble line) (cond ((eof-object? line) #f) ((equal? line boundary) #t) (else (skip-preamble (read-byte-line))))) ;; collect parts (define (collect-parts parts) (let loop ((parts '())) (let loop2 ((line (read-byte-line)) (lines '())) (cond ((eof-object? line) (cons (string-join (reverse! lines) "\r\n") parts)) ((equal? (string-complete->incomplete line) (string-complete->incomplete boundary)) (loop (cons (string-join (reverse! lines) "\r\n") parts))) (else (loop2 (read-byte-line) (cons line lines))))))) ;; language (define lang #t) ;; main body (and (skip-preamble (read-byte-line)) (fold (lambda (part number) (with-input-from-string part (lambda () (let1 lg (tokenize-message #`",|file|#,|number|" charset receiver) (when (symbol? lg) (set! lang lg))))) (+ number 1)) 0 (reverse! (collect-parts '()))) lang) ) ;; Tokenizer utilities (define (flush-token lis receiver) (unless (or (null? lis) (null? (cdr lis)) (every (cut char-set-contains? #[\d_-] <>) lis)) (receiver (list->string (map char-downcase (reverse! lis)))))) ;; japanese delimiting characters ;; these are used as hints for tokenizer. (define char-set:ja-delimiters (char-set #\u3002 ;; #\。 #\u3001 ;; #\、 #\uff0c ;; #\， #\u30fb ;; #\・ #\u300c ;; #\「 #\u300d ;; #\」 #\u300e ;; #\『 #\u300f ;; #\』 )) (define char-set:ja-kanji (case (gauche-character-encoding) ((utf-8) (ucs-range->char-set #x4e00 #x9fef)) ;; CJK unified ideograms ((euc-jp sjis) (integer-range->char-set (char->integer #\u4e9c) ;; #\亜 (char->integer #\u7464) ;; #\瑤 )) (else #[]))) ;; Base tokenizer for (potentially) Japanese message. (define (tokenize-port receiver) (define alnum-count 0) (define mb-count 0) (define (alnum? ch) (char-set-contains? #[-$'!\w] ch)) (define (mb? ch) (>= (char->integer ch) 256)) (define (kanji? ch) (char-set-contains? char-set:ja-kanji ch)) (define (ascii ch acc) (inc! alnum-count) (cond ((eof-object? ch) (flush-token acc receiver)) ((mb? ch) (flush-token acc receiver) (multibyte (read-char) ch)) ((alnum? ch) (ascii (read-char) (cons ch acc))) (else (flush-token acc receiver) (blank (read-char))))) (define (blank ch) (cond ((eof-object? ch)) ((mb? ch) (multibyte (read-char) ch)) ((alnum? ch) (ascii (read-char) (list ch))) (else (blank (read-char))))) (define (multibyte ch prev) (inc! mb-count) (cond ((eof-object? ch)) ((or (eqv? ch #\return) (eqv? ch #\newline)) (multibyte (read-char) prev)) ;; ignore newlines between mb char ((mb? ch) (cond ((char-set-contains? char-set:ja-delimiters ch) (multibyte (read-char) #f)) (prev (unless (and (not (kanji? prev)) (kanji? ch)) (flush-token (list ch prev) receiver)) (multibyte (read-char) ch)) (else (multibyte (read-char) ch)))) ((alnum? ch) (ascii (read-char) (list ch))) (else (blank (read-char))))) (ascii (read-char) '()) ;; We use heuristics to determine if the message is Japanese or not. ;; If more than 20% of its characters are multibyte, we assume it's a ;; japanese message. (if (> (* mb-count 4) alnum-count) 'ja #t)) ;; Base tokenizer for ASCII message. (define (tokenize-port-iso8859 receiver) (define (alnum? b) (char-set-contains? #[-$'!\w] (integer->char b))) (define (ascii b acc) (cond ((eof-object? b) (flush-token acc receiver)) ((alnum? b) (ascii (read-byte) (cons (integer->char b) acc))) (else (flush-token acc receiver) (blank (read-byte))))) (define (blank b) (cond ((eof-object? b)) ((alnum? b) (ascii (read-byte) (list (integer->char b)))) (else (blank (read-byte))))) (ascii (read-byte) '()) #t) ;; helper function to get a line as a byte string (define (read-byte-line . maybe-port) (read-line (get-optional maybe-port (current-input-port)) #t)) (define (get-content-type headers) (rfc822-header-ref headers "content-type")) (define (get-transfer-encoding headers) (rfc822-header-ref headers "content-transfer-encoding")) (define (get-mime-boundary content-type) (cond ((and content-type (not (string-incomplete? content-type)) (#/multipart\/\w+\;.*boundary=\s*\"?([-+'(),.\/:=?\w ]+)\"?/i content-type)) => (lambda (m) (string-append "--" (m 1)))) (else #f))) (define (get-charset content-type default) (cond ((and content-type (not (string-incomplete? content-type)) (#/charset=\"?([-_\w.]+)\"?/ content-type)) => (cut <> 1)) (default) (else "*ja"))) ;;guess (provide "bayesian-filter") scmail-1.3.orig/dot.scmail/0002755000175000017500000000000010101462373016334 5ustar gniibegniibe00000000000000scmail-1.3.orig/dot.scmail/config.sample0000644000175000017500000000107410061102402020771 0ustar gniibegniibe00000000000000;; -*- scheme -*- ( :smtp-host "localhost" :log-file "~/.scmail/log" :umask #o077 ;; for usual mail filtering :refile-rules "~/.scmail/refile-rules" :deliver-rules "~/.scmail/deliver-rules" ;; for spam filtering :token-table "~/.scmail/token-table.dbm" :digest "~/.scmail/digest.dbm" ;; for MH :mailbox "~/Mail" :inbox "inbox" :spam "spam" ; a folder for spam mails :mailbox-type mh ;; for Maildir ;; :mailbox "~/Maildir" ;; :inbox "" ;; :spam ".spam" ; a folder for spam mails ;; :mailbox-type maildir ) scmail-1.3.orig/dot.scmail/refile-rules.sample0000644000175000017500000000165110061102402022123 0ustar gniibegniibe00000000000000;; -*- scheme -*- (add-filter-rule! ;; ;; Refile a mail from "foo@example.jp" to "from/foo" folder. ;; '(from ("foo@example.jp" "from/foo")) ;; ;; Refile a mail to "admin@example.com" to "admin" folder. ;; '(to/cc ("admin@example.com" "admin")) ;; ;; Refile a mail from a mailing list according to List-Id header. ;; e.g. "List-Id: " => "ml/ml.example.jp" ;; '(list-id (#/<([-.\w]+)>/ "ml/\\1")) ;; ;; Refile a mail from a mailing list according to X-ML-Name header. ;; e.g. "X-ML-Name: foo-ml" => "ml/foo-ml" ;; '(x-ml-name (#/([-.\w]+)/ "ml/\\1")) ;; ;; Refile a mail from satoru@example.jp or satoru@example.org ;; to "from/satoru" folder. ;; '(from (("satoru@example.jp" "satoru@example.org") "from/satoru"))) ;; Replace unsafe characters with `-' in match data. (set-match-data-replace-rule! '(#/[^a-zA-Z0-9_-]/ "-")) ;; Filter spam mails ;; (add-bayesian-filter-rule!) scmail-1.3.orig/dot.scmail/deliver-rules.sample.in0000644000175000017500000000303110061102402022706 0ustar gniibegniibe00000000000000;; -*- scheme -*- ;; ;; Copy all mails to "inbox-all" folder for backup. ;; (add-filter-rule! (lambda (mail) (copy mail "inbox-all"))) (add-filter-rule! ;; ;; Forward a mail from "partner@example.net" to "mobile@example.com". ;; (a copy of mail remains) ;; '(from ("partner@example.net" (forward "mobile@example.com"))) ;; ;; Redirect a mail from "partner@example.net" to "mobile@example.com". ;; (a copy of mail doesn't remain) ;; '(from ("partner@example.net" (redirect "mobile@example.com"))) ;; ;; Drop a mail writtein in unreadable charcodes to "spam". ;; For people who cannot read a mail written in Chinese and Korean. ;; '(content-type (#/gb2312|euc-kr|big5|gbk|ks_c_5601/i "spam")) ;; ;; Drop a Japanese spam mail to "spam" folder. ;; '(subject ((#/[未末]承[認諾]広告[*＊※]/ #/[！!]広告[！!]/) "spam"))) ;; ;; Drop a mail containing "viagra" in Subject: and "text/html" in the body ;; to "spam" folder. ;; (add-filter-rule! (lambda (mail) (and (mail 'subject "viagra") (mail 'body "text/html") (refile mail "spam")))) ;; Filter spam mails. ;; Please use scbayes to learn spam and nonspam mails beforehand. ;; (add-bayesian-filter-rule!) ;; Filter spam mails using a white list. ;; (use srfi-1) ;; (use scmail.bayesian-filter) ;; (define white-list ;; (list "friends@example.net" ;; "family@example.net")) ;; (add-filter-rule! ;; (lambda (mail) ;; (and (not (any (cut mail 'from <>) white-list)) ;; (mail-is-spam? mail) ;; (refile mail "spam")))) scmail-1.3.orig/tests/0002755000175000017500000000000010101462373015441 5ustar gniibegniibe00000000000000scmail-1.3.orig/tests/Makefile0000644000175000017500000000202110101210553017061 0ustar gniibegniibe00000000000000TESTS = syntax.scm mail.scm util.scm config.scm progress.scm \ scmail.scm bayesian-filter.scm mailbox.scm MAIL = 1 2 3 4 5 6 7 8 TARGET = bayesian-filter.scm test-rules all: $(TARGET) test-rules: test-rules.in rm -f test-rules gosh ../codeconv.scm test-rules.in > test-rules chmod -w test-rules bayesian-filter.scm: bayesian-filter.scm.in rm -f bayesian-filter.scm gosh ../codeconv.scm bayesian-filter.scm.in > bayesian-filter.scm chmod -w bayesian-filter.scm check: clean all mh-mailbox maildir-mailbox @rm -f test.log @for i in $(TESTS); do \ gosh -I.. $$i >> test.log; \ done @./scmail-commands >> test.log mh-mailbox: @mkdir -p Mail/inbox @cp $(MAIL) Mail/inbox maildir-mailbox: @mkdir -p Maildir/cur @mkdir -p Maildir/new @mkdir -p Maildir/tmp @for i in $(MAIL); do \ suffix=""; \ test $$i = 1 && suffix=":abc"; \ test $$i = 2 && suffix=",abc:def"; \ cp $$i Maildir/cur/100000000$$i.localhost$$suffix; \ done clean: @rm -f $(TARGET) @rm -rf Mail Maildir test.* scmail-1.3.orig/tests/config.scm0000644000175000017500000000477510061102402017412 0ustar gniibegniibe00000000000000(use gauche.test) (use file.util) (use srfi-1) (test-start "scmail.config") (use scmail.config) (test-module 'scmail.config) (with-module scmail.config ;; disable choosing old files. (define (choose path) path)) (define temporary-directory (build-path (current-directory) "test.dot.scmail")) (test* "scmail-config-default-file" #t (string=? (scmail-config-default-file) (expand-path "~/.scmail/config"))) (test "scmail-config-set-directory!" #t (lambda () (scmail-config-set-directory! temporary-directory) #t)) (test* "scmail-config-default-file" #t (string=? (scmail-config-default-file) (build-path temporary-directory "config"))) (test "scmail-config-make-directory" #t (lambda () (scmail-config-make-directory) (file-is-directory? temporary-directory))) ;; try again to check whether it works if the directory already existed. (test "scmail-config-make-directory" #t (lambda () (scmail-config-make-directory) (file-is-directory? temporary-directory))) (remove-directory* temporary-directory) (test* "scmail-config" #t (is-a? (scmail-config) )) (test* "scmail-config-get-path" #t (every (lambda (pair) (let ((slot (car pair)) (path (build-path temporary-directory (cdr pair)))) (string=? (scmail-config-get-path slot) path))) '( (deliver-rules . "deliver-rules") (refile-rules . "refile-rules") (log-file . "log") (token-table . "token-table.dbm") (digest . "digest.dbm") ))) (test "scmail-config-read" #t (lambda () (scmail-config-read (build-path (current-directory) "../dot.scmail/config.sample")) (is-a? (scmail-config) ))) (test* "scmail-config-get-path" #t (every (lambda (pair) (let ((slot (car pair)) (path (build-path (expand-path "~/.scmail") (cdr pair)))) (string=? (scmail-config-get-path slot) path))) '( (deliver-rules . "deliver-rules") (refile-rules . "refile-rules") (log-file . "log") (token-table . "token-table.dbm") (digest . "digest.dbm") ))) (test-end) scmail-1.3.orig/tests/dummy-socket.scm0000644000175000017500000000101310062704762020566 0ustar gniibegniibe00000000000000(use gauche.net) ;; borrowed from tests/mail.scm (with-module gauche.net (define (smtp-responses) (string-join (map number->string (list 220 250 250 250 354 250 221 )) "\n")) (define (call-with-client-socket socket proc) (call-with-input-string (smtp-responses) (lambda (smtp-port) (proc smtp-port (standard-output-port))))) (define (make-client-socket type host port) 'dummy)) scmail-1.3.orig/tests/mail.scm0000644000175000017500000001016710061102402017057 0ustar gniibegniibe00000000000000(use gauche.test) (use file.util) (use rfc.822) (use srfi-1) (use gauche.uvector) (use gauche.net) (test-start "scmail.mail") (use scmail.mail) (test-module 'scmail.mail) (define test-file "1") (define temporary-file "test.tmp") (define mail #f) (define (file->string file) (let* ((iport (open-input-file file)) (string (port->string iport))) (close-input-port iport) string)) (test "make" #t (lambda () (set! mail (make :file test-file)) (string=? (file->string test-file) (string-incomplete->complete (ref mail 'content))))) (test* "scmail-mail-from-stdin?" #f (scmail-mail-from-stdin? mail)) (test* "scmail-mail-removed?" #f (scmail-mail-removed? mail)) (test "scmail-mail-write" #t (lambda () (scmail-mail-write mail temporary-file) (string=? (file->string test-file) (file->string temporary-file)))) (test "scmail-mail-remove and scmail-mail-removed?" #t (lambda () (let1 tmp (make :file temporary-file) (and (scmail-mail-remove tmp) (scmail-mail-removed? tmp) (not (file-exists? temporary-file)))))) (test "scmail-mail-query" #t (lambda () (call-with-input-file test-file (lambda (iport) (every (lambda (field) (string=? (cadr field) (scmail-mail-query mail (string->symbol (car field))))) (rfc822-header->list iport)))))) (test* "scmail-mail-query" #t (string=? (scmail-mail-query mail 'file) (scmail-mail-query mail 'file-name))) (test* "scmail-mail-query" #t (string=? (scmail-mail-query mail 'file) (scmail-mail-query mail 'file-name))) (test* "scmail-mail-query" #t (string=? (scmail-mail-query mail 'body) (string-scan (file->string test-file) "\n\n" 'after))) (test* "scmail-mail-decode-field successful" #t (equal? #u8(#xa4 #xa2 #x61 #x62 #x63) ; "あabc" in euc (string->u8vector (scmail-mail-decode-field "=?iso-2022-jp?Q?=1B=24=42=24=22=1B=28=42?=abc" "eucjp")))) (test* "scmail-mail-decode-field" #t (equal? #u8(#xa4 #xa2 #x61 #x62 #x63) ; "あabc" in euc (string->u8vector (scmail-mail-decode-field "=?iso-2022-jp?Q?=1B=24=42=24=22=1B=28=42?=abc" "eucjp")))) (test* "scmail-mail-decode-field" #t (equal? #u8(#xa4 #xa2 #x61 #x62 #x63) ; "あabc" in euc (string->u8vector (scmail-mail-decode-field "=?ISO-2022-JP?B?GyRCJCIbKEJhYmM=?=" "eucjp")))) (test* "scmail-mail-decode-field" #t (string=? "=?iso-9999-jp?Q?=1B=24=42=24=22=1B=28=42?=abc" (scmail-mail-decode-field "=?iso-9999-jp?Q?=1B=24=42=24=22=1B=28=42?=abc" "eucjp"))) (with-module gauche.net (define (smtp-responses) (string-join (map number->string (list 220 250 250 250 354 250 221 )) "\n")) (define (call-with-client-socket socket proc) (call-with-input-string (smtp-responses) (lambda (smtp-port) (proc smtp-port (standard-output-port))))) (define (make-client-socket type host port) 'dummy)) (test* "scmail-send-mail" #t (call-with-input-string "From: foo@example.org\n\n.Hello!\n" (lambda (iport) (newline) (scmail-send-mail "localhost" 25 iport "from@example.org" "to@example.net")))) (test* "scmail-send-mail" #t (call-with-input-string #*"From: foo@example.org\n\n.Hello!\n\xff\n" (lambda (iport) (newline) (scmail-send-mail "localhost" 25 iport "from@example.org" "to@example.net")))) (test "scmail-mail-forward" #t (lambda () (newline) (scmail-mail-forward mail "localhost" "to@example.org"))) (test-end) scmail-1.3.orig/tests/mailbox.scm0000644000175000017500000000241110101211412017556 0ustar gniibegniibe00000000000000(use gauche.test) (use srfi-1) (test-start "scmail.mailbox") (use scmail.mailbox) (use scmail.mh) (use scmail.maildir) (test-module 'scmail.mailbox) (define mailbox-table '((mh #f "Mail" "inbox") (maildir #f "Maildir" ""))) (define (mailbox-list) (map second mailbox-table)) (define type-of first) (define object-of second) (define location-of third) (define inbox-of fourth) (test "make-scmail-mailbox" #t (lambda () (for-each (lambda (mailbox) (let ((type (type-of mailbox)) (location (location-of mailbox))) (set-car! (cdr mailbox) (make-scmail-mailbox type location)))) mailbox-table) (with-error-handler (lambda (e) ;; error should be occurred (print (ref e 'message)) #t) (lambda () (set! xxx-mailbox (make-scmail-mailbox 'xxx "/dev/null")) #f)))) (test "scmail-mailbox-mail-list" #t (lambda () (every (lambda (mailbox) (= (length (scmail-mailbox-mail-list (object-of mailbox) (inbox-of mailbox))) 8)) mailbox-table))) (test-end) scmail-1.3.orig/tests/progress.scm0000644000175000017500000000077610061102402020006 0ustar gniibegniibe00000000000000(use gauche.test) (test-start "scmail.progress") (use scmail.progress) (test-module 'scmail.progress) (test "progress" #t (lambda () (let1 progress (make :total 100 :port (current-output-port) :title "test") (dotimes (i 100) (sys-nanosleep 10000000) (progress-inc! progress)) (progress-finish! progress)) #t)) (test-end) scmail-1.3.orig/tests/scmail.scm0000644000175000017500000002077510101215612017416 0ustar gniibegniibe00000000000000;; -*- scheme -*- (use gauche.test) (use srfi-1) (use file.util) (use srfi-13) (test-start "scmail") (use scmail) (use scmail.mail) (use scmail.mailbox) (use scmail.config) (test-module 'scmail) (with-module scmail (export filter-rules bayesian-filter read-filter-rule)) (sys-system "rm -f test.log.mh test.log.maildir test.log.maildir2") (sys-system "rm -rf test.Mail test.Maildir test.Maildir2") (sys-system "cp -rp Mail test.Mail") (sys-system "cp -rp Maildir test.Maildir") (sys-system "cp -rp Maildir test.Maildir2") (sys-system "mv test.Maildir2/cur/* test.Maildir2/new") ;; for testing "new" (slot-set! (scmail-config) 'log-file (build-path (current-directory) "test.log.scmail")) (test* "filter-rules" #t (null? (filter-rules))) (define valid-rules (list '(from) '(from ("foo@example.org" "from.foo")) '(from ("foo@example.org" (copy "from.foo"))) '(from ("foo@example.org" (remove))) '(from (#/foo@example.(org|com)#/ "from.foo")) '(from (("foo@example.org" #/foo@example.com/) "from.foo")) '(from ("foo@example.org" "from.foo") ("bar@example.org" "from.bar")) (lambda (mail) (and (mail 'from "foo@examle.org") (refile mail "from.foo"))) (lambda (config mail) (if (string-contains? (scmail-mail-query mail 'from) "foo@examle.org") (command-refile config mail "from.foo") :next)) )) (define invalid-rules (list 'from '(from "foo@example.org") '(from ("foo@example.org")) '(from ("foo@example.org" "from.foo" 'extra)) '(from ("foo@example.org" (copy "from.foo" 'extra))) '(from (("foo@example.org" "from.foo"))) (lambda () #t) (lambda (a b c) #t) )) (test* "valid-rule?" #t (every (lambda (rule) (valid-rule? rule)) valid-rules)) (test* "valid-rule?" #t (every (lambda (rule) (not (valid-rule? rule))) invalid-rules)) (test "add-filter-rule!" #t (lambda () (apply add-filter-rule! invalid-rules) (null? (filter-rules)))) (test "add-filter-rule!" #t (lambda () (apply add-filter-rule! valid-rules) (equal? (filter-rules) valid-rules))) (test "add-bayesian-filter-rule!" #t (lambda () (add-bayesian-filter-rule!) (equal? (first (reverse (filter-rules))) bayesian-filter))) (define (reset-filter-rules) (filter-rules '())) (define (count-number-of-lines file) (if (file-exists? file) (let* ((iport (open-input-file file)) (string (port->string iport))) (close-input-port iport) (string-count string #\newline)) 0)) ;; borrowed from tests/mail.scm (with-module gauche.net (define (smtp-responses) (string-join (map number->string (list 220 250 250 250 354 250 221 )) "\n")) (define (call-with-client-socket socket proc) (call-with-input-string (smtp-responses) (lambda (smtp-port) (proc smtp-port (standard-output-port))))) (define (make-client-socket type host port) 'dummy)) (define (number-of-files-in-directory directory) (length (directory-fold directory (lambda (entry result) (if (file-is-regular? entry) (cons entry result) result)) '()))) (define (test-mailbox task subdir) (let ((mailbox (make-scmail-mailbox (ref (scmail-config) 'mailbox-type) (ref (scmail-config) 'mailbox)))) (test-section task) (test "scmail-command-log" #t (lambda () (let1 before (count-number-of-lines (ref (scmail-config) 'log-file)) (scmail-command-log "test" "src" "dest") (= (+ 1 before) (count-number-of-lines (ref (scmail-config) 'log-file)))))) (test "scmail-error-log" #t (lambda () (let1 before (count-number-of-lines (ref (scmail-config) 'log-file)) (scmail-error-log "test error") (= (+ 1 before) (count-number-of-lines (ref (scmail-config) 'log-file)))))) (test "scmail-log" #t (lambda () (let1 before (count-number-of-lines (ref (scmail-config) 'log-file)) (scmail-log "test log") (= (+ 1 before) (count-number-of-lines (ref (scmail-config) 'log-file)))))) (reset-filter-rules) (read-filter-rule "test-rules") (test "scmail-filter/copy/refile/forward/redirect" #t (lambda () (let* ((mailbox-type (ref (scmail-config) 'mailbox-type)) (mailbox (make-scmail-mailbox mailbox-type (ref (scmail-config) 'mailbox)))) (for-each (lambda (file) (scmail-filter (make-scmail-mail mailbox-type :mailbox mailbox :file file))) (scmail-mailbox-mail-list mailbox (ref (scmail-config) 'inbox))) #t))) (test* "refile result" #t (every (lambda (pair) (= (number-of-files-in-directory (build-path (car pair) (if (eq? (ref (scmail-config) 'mailbox-type) 'maildir) subdir ""))) (cdr pair))) (list (cons (scmail-mailbox-folder->path mailbox (ref (scmail-config) 'inbox)) 1) (cons (scmail-mailbox-folder->path mailbox "spam") 2) (cons (scmail-mailbox-folder->path mailbox "backup") 8) (cons (scmail-mailbox-folder->path mailbox "from.foo") 1) (cons (scmail-mailbox-folder->path mailbox "to.former") 1) (cons (scmail-mailbox-folder->path mailbox "ml.test-ml-example-org") 1)))) )) (slot-set! (scmail-config) 'mailbox-type 'mh) (slot-set! (scmail-config) 'mailbox (build-path (current-directory) "test.Mail")) (slot-set! (scmail-config) 'inbox "inbox") (slot-set! (scmail-config) 'spam "spam") (slot-set! (scmail-config) 'log-file (build-path (current-directory) "test.log.mh")) (test-mailbox "MH" "dummy") (slot-set! (scmail-config) 'mailbox-type 'maildir) (slot-set! (scmail-config) 'mailbox (build-path (current-directory) "test.Maildir")) (slot-set! (scmail-config) 'inbox "") (slot-set! (scmail-config) 'spam "spam") (slot-set! (scmail-config) 'log-file (build-path (current-directory) "test.log.maildir")) (test-mailbox "Maildir" "cur") (slot-set! (scmail-config) 'mailbox-type 'maildir) (slot-set! (scmail-config) 'mailbox (build-path (current-directory) "test.Maildir2")) (slot-set! (scmail-config) 'inbox "") (slot-set! (scmail-config) 'spam "spam") (slot-set! (scmail-config) 'log-file (build-path (current-directory) "test.log.maildir2")) (test-mailbox "Maildir2" "new") (define (grep-c pattern file) (let1 count 0 (call-with-input-file file (lambda (port) (port-for-each (lambda (line) (when (rxmatch pattern line) (inc! count) )) (cut read-line port)))) count)) (define log-files (list "test.log.mh" "test.log.maildir" "test.log.maildir2")) (test* "log files (number of lines)" #t (apply = (map count-number-of-lines log-files))) (test* "log files (#)" #t (every (cut = <> 0) (map (lambda (file) (grep-c #/#/ file)) log-files))) (test-end) ;; scmail-main scmail-1.3.orig/tests/syntax.scm0000644000175000017500000000063010061102402017455 0ustar gniibegniibe00000000000000(use gauche.test) (test-start "syntax") (define (target-files) (apply append (map sys-glob '("../*.in" "../dot.scmail/*.sample" "../scmail/*.scm")))) (test "all files" 'ok (lambda () (for-each (lambda (file) (call-with-input-file file port->sexp-list)) (target-files)) 'ok)) (test-end) scmail-1.3.orig/tests/util.scm0000644000175000017500000000313510061102402017107 0ustar gniibegniibe00000000000000(use gauche.test) (test-start "scmail.util") (use scmail.util) (use scmail.config) (use scmail.progress) (test-module 'scmail.util) (test* "safe-rxmatch" #f (safe-rxmatch #/abc/ (string-complete->incomplete "abcdefg"))) (test* "safe-rxmatch" #t (regmatch? (safe-rxmatch #/abc/ "abcdefg"))) (test* "scmail-set-program-name!" #f (scmail-set-program-name! "test")) (with-module scmail.util (export get-last-line) (define (exit . args) (format #t "exit ~a" args)) (define output-port (open-output-string)) (define standard-error-port (lambda () output-port)) (define (get-last-line) (call-with-input-string (get-output-string output-port) (lambda (iport) (car (reverse (port->string-list iport))))))) (test "scmail-wformat" #t (lambda () (scmail-wformat "foo") (string=? "test: foo" (get-last-line)))) (test "scmail-dformat" #f (lambda () (scmail-dformat "foo") (string=? "test: debug: foo" (get-last-line)))) (scmail-config-set-verbose-mode!) (test "scmail-dformat" #t (lambda () (scmail-dformat "foo") (string=? "test: debug: foo" (get-last-line)))) (test "scmail-eformat" #t (lambda () (scmail-eformat "exit") (string=? "test: exit" (get-last-line)))) (test "scmail-eformat" #t (lambda () (scmail-eformat "exit") (string=? "test: exit" (get-last-line)))) (test-end) scmail-1.3.orig/tests/10000644000175000017500000000032010061102402015502 0ustar gniibegniibe00000000000000To: foo@example.org Subject: test 1 From: Foo Date: Mon, 12 Jan 2004 15:36:23 +0900 Message-Id: <20040112153623@example.org> Content-Type: text/plain; charset=US-ASCII This is a test mail. scmail-1.3.orig/tests/20000644000175000017500000000037610061102402015516 0ustar gniibegniibe00000000000000To: test-mailing-list@example.org Subject: [test-ml] test 2 From: Announce Date: Mon, 13 Jan 2004 13:29:23 +0900 List-Id: The test mailing list Content-Type: text/plain; charset=US-ASCII This is a test mail. scmail-1.3.orig/tests/30000644000175000017500000000041010061102402015504 0ustar gniibegniibe00000000000000Date: Wed, 14 Jan 2004 11:24:32 +0900 Message-ID: <2003-114112432@example.org> From: Foo To: foo@example.org Subject: =?ISO-2022-JP?B?GyRCJUYlOSVIGyhC?= MIME-Version: 1.0 Content-Type: text/plain; charset=ISO-2022-JP $B$3$l$O%F%9%H%a!<%k$G$9(B scmail-1.3.orig/tests/40000644000175000017500000000052010061102402015507 0ustar gniibegniibe00000000000000Date: Wed, 14 Jan 2004 11:28:31 +0900 Message-ID: <20040114112831@example.org> From: Spammer To: foo@example.org Subject: =?ISO-2022-JP?B?GyRCTCQ+NUJ6OS05cCIoGyhCcHJvY21haWwbJEIkRyViGyhC?= =?ISO-2022-JP?B?GyRCJUYlYiVGGyhC?= MIME-Version: 1.0 Content-Type: text/plain; charset=ISO-2022-JP $B$K$J$k$o$1$b$J$/!#(B scmail-1.3.orig/tests/50000644000175000017500000000037310061102402015516 0ustar gniibegniibe00000000000000To: foo@example.org Subject: Get Rich, Viagra, Sex, Millionaire From: Spammer Date: Mon, 14 Jan 2004 11:36:23 +0900 Message-Id: <20040114113623@example.org> Content-Type: text/plain; charset=US-ASCII Orgasms, Increases, Nigeria scmail-1.3.orig/tests/60000644000175000017500000000036010061102402015513 0ustar gniibegniibe00000000000000Date: Wed, 14 Jan 2004 11:28:31 +0900 Message-ID: <20040202134531@example.org> From: Nenchaku To: foo@example.org Subject: $B$M$A$M$A(B MIME-Version: 1.0 Content-Type: text/plain; charset=ISO-2022-JP $B$M$P$M$P(B scmail-1.3.orig/tests/70000644000175000017500000000035310101211071015514 0ustar gniibegniibe00000000000000Date: Fri, 12 Mar 2004 17:53:31 +0900 Message-ID: <20040312175331@example.org> From: Someone To: foo@example.org Subject: just a mail MIME-Version: 1.0 Content-Type: text/plain; it must be stored into the inbox. scmail-1.3.orig/tests/80000644000175000017500000000052310101210705015517 0ustar gniibegniibe00000000000000Date: Mon, 26 Jul 2004 23:06:17 +0900 Message-ID: <20040726230617@example.org> Delivered-To: old-address@example.jp Delivered-To: former-address@example.jp Delivered-To: recent-address@example.jp From: Old Friend To: old-address@example.jp Subject: hi MIME-Version: 1.0 Content-Type: text/plain; long time no see! scmail-1.3.orig/tests/bayesian-filter.scm.in0000644000175000017500000001104510061102402021614 0ustar gniibegniibe00000000000000;;; -*- scheme -*- (use gauche.test) (use srfi-1) (use srfi-13) (test-start "scmail.bayesian-filter") (use scmail.bayesian-filter) (use scmail.config) (use scmail.mail) (use file.util) (test-module 'scmail.bayesian-filter) (test* "token-table-index-of-spam" #t (and (= (token-table-index-of-spam #t) 1) (= (token-table-index-of-spam 'ja) 3))) (test* "token-table-index-of-nonspam" #t (and (= (token-table-index-of-nonspam #t) 0) (= (token-table-index-of-nonspam 'ja) 2))) (with-module scmail.config ;; disable choosing old files. (define (choose path) path)) (if (file-is-directory? "test.bayesian") (remove-directory* "test.bayesian")) (scmail-config-set-directory! (build-path (current-directory) "test.bayesian")) (scmail-config-make-directory) (define (get-token-count) (with-token-table (scmail-config-get-path 'token-table) :read (lambda () (vector->list (token-table-token-count))))) (define (get-message-count) (with-token-table (scmail-config-get-path 'token-table) :read (lambda () (vector->list (token-table-message-count))))) (define (learn process-words) (let ((mail-table (list (list token-table-index-of-nonspam (token-table-index-of-nonspam #t) "1") (list token-table-index-of-nonspam (token-table-index-of-nonspam #t) "2") (list token-table-index-of-nonspam (token-table-index-of-nonspam 'ja) "3") (list token-table-index-of-spam (token-table-index-of-spam 'ja) "4") (list token-table-index-of-spam (token-table-index-of-spam #t) "5")))) (for-each (lambda (item) (let* ((table (first item)) (index (second item)) (file (third item))) (with-token-table (scmail-config-get-path 'token-table) :write (lambda () (process-words (make :file file) table) (token-table-cache-flush) )))) mail-table))) (test "token-table-collect-words" #t (lambda () (learn token-table-collect-words) (and (every (lambda (x) (> x 0)) (get-token-count)) (= (apply + (get-message-count)) 5)))) ;; run twice (dotimes (i 2) (test "token-table-discard-words" #t (lambda () (learn token-table-discard-words) (and (every (lambda (x) (= x 0)) (get-token-count)) (= (apply + (get-message-count)) 0))))) (test "with-token-table/token-table-collect-words" #t (lambda () (learn token-table-collect-words) (let1 first-time (get-token-count) ;; repeat four times for fast learning (dotimes (i 4) (learn token-table-collect-words) (let1 v (get-token-count) (unless (equal? v first-time) (errorf "total-token-count differs"))))) #t)) (test "token-table-for-each" #t (lambda () (with-token-table (scmail-config-get-path 'token-table) :read (lambda () (token-table-for-each (lambda (key value) (unless (string-prefix? (token-table-special-key-prefix) key) (format #t "~a\t~a\n" key value)))))) #t)) (test* "load-prob-tables" #t (load-prob-tables "foo")) (test* "spamness-of-word" #t (and (> (spamness-of-word "viagra" #t) 0.9) (> (spamness-of-word "諾広" 'ja) 0.9))) (test* "spamness-of-word" #t (and (< (spamness-of-word "test" #t) 0.1) (< (spamness-of-word "テス" 'ja) 0.1))) (test* "spamness-of-mail" #t (and (every (lambda (file) (let1 spamness (spamness-of-mail (make :file file)) (< spamness 0.1))) (list "1" "2" "3")))) (test* "spamness-of-mail" #t (and (every (lambda (file) (let1 spamness (spamness-of-mail (make :file file)) (> spamness 0.9))) (list "4" "5")))) (test* "mail-is-spam?" #t (and (not (mail-is-spam? "1")) (not (mail-is-spam? "2")) (not (mail-is-spam? "3")))) (test* "mail-is-spam?" #t (and (mail-is-spam? (make :file "4")) (mail-is-spam? (make :file "5")))) ;; convert-database (test-end) scmail-1.3.orig/tests/test-rules.in0000644000175000017500000000133310101215556020075 0ustar gniibegniibe00000000000000;;; -*- scheme -*- (add-filter-rule! (lambda (mail) (copy mail "backup")) '(from ("foo@example.jp" (redirect "mobile@example.org")) (("foo@example.org" "foo@example.jp") "from.foo") ("nenchaku@example.jp" (remove)) ) '(delivered-to ("former-address@example.jp" "to.former")) '(to/cc ("test-mailing-list@example.org" (forward "ml@example.org"))) '(list-id (#/<([^>]+)>/ "ml.\\1")) '(subject (#/未承諾広告※/ "spam")) '(for-test ("This is an intentionally invalid rule")) (lambda (mail) (and (mail 'subject "Viagra") (mail 'body "Nigeria") (refile mail "spam"))) ) (set-match-data-replace-rule! '(#/[^a-zA-Z0-9_-]/ "-")) scmail-1.3.orig/tests/scmail-commands0000755000175000017500000001741110101211132020421 0ustar gniibegniibe00000000000000#! /bin/sh if test ! -d Mail -o ! -d Maildir; then echo "please prepare mailboxes" exit 1 fi if test ! -d test.Mail -o ! -d test.Maildir; then echo "Please run scmail.scm test first." exit 1 fi SCMAIL_REFILE="gosh -I. -I.. -l dummy-socket.scm ../scmail-refile" check_nfiles() { if test `find $1 -type f -print |wc -l` != \ `find $2 -type f -print |wc -l`; then echo "Number of files differs: $1 and $2" exit 1 fi } scbayes_common() { task=$1 config=$2 shift shift echo -n "scbayes ${task}ing... " gosh -I.. ../scbayes -d $PWD/test.scmail -q -c $config $* --$task-spam spam gosh -I.. ../scbayes -d $PWD/test.scmail -q -c $config $* --$task-nonspam from.foo ml.test-ml-example-org echo "done." } scbayes_learn() { scbayes_common learn $* } scbayes_unlearn() { scbayes_common unlearn $* } scbayes_learn3() { for i in 1 2 3; do scbayes_learn $* done } scbayes_check() { if gosh -I.. ../scbayes -c $1 --check-spam spam; then echo "spam filtering succeeded" else echo "ERROR: spam filtering failed" exit 1 fi gosh -I.. ../scbayes -c test.config --check-mail 5 || exit 1 if gosh -I.. ../scbayes -c $1 --check-nonspam from.foo; then echo "nonspam filtering succeeded" else echo "ERROR: nonspam filtering failed" exit 1 fi gosh -I.. ../scbayes -c test.config --check-mail 1 || exit 1 } rm -f test.scmail-deliver rm -rf test.Mail2 test.Maildir2 cp -rp Mail test.Mail2 cp -rp Maildir test.Maildir2 inode_before=`ls -i test.Maildir2/cur/1000000001.localhost:abc | awk '{print $1}'` rm -rf test.scmail mkdir test.scmail rm -rf test.scmail mkdir test.scmail cat < test.config ( :smtp-host "localhost" :log-file "$PWD/test.scmail/log" :umask #o007 :token-table "$PWD/test.scmail/token-table.dbm" :digest "$PWD/test.scmail/digest.dbm" :size-limit 1024 ;; for MH :mailbox "$PWD/test.Mail2" :inbox "inbox" :spam "spam" ; a folder for spam mails :mailbox-type mh ) EOF cat < test.config2 ( :smtp-host "localhost" :log-file "$PWD/test.scmail/log" :umask #o007 :token-table "$PWD/test.scmail/token-table.dbm" :digest "$PWD/test.scmail/digest.dbm" :size-limit 1024 ;; for Maildir :mailbox "$PWD/test.Maildir2" :inbox "" :spam "spam" ; a folder for spam mails :mailbox-type maildir ) EOF gosh -ugauche.test -e '(test-start "scmail-refile --dry-run")' -Eexit $SCMAIL_REFILE -d $PWD/test.scmail -c test.config -r test-rules -n |tee test.log.dryrun diff -r Mail test.Mail2 || exit 1 $SCMAIL_REFILE -d $PWD/test.scmail -c test.config2 -r test-rules -n |tee test.log.dryrun2 diff -r Maildir test.Maildir2 || exit 1 gosh -ugauche.test -e '(test-end)' -Eexit gosh -ugauche.test -e '(test-start "scmail-refile/scmail-deliver for MH")' -Eexit $SCMAIL_REFILE -d $PWD/test.scmail -c test.config -r test-rules |tee test.log.normal diff -r test.Mail test.Mail2 || exit 1 # log files to stdout must be same diff test.log.dryrun test.log.normal # dry run cat 5 | gosh -I.. ../scmail-deliver -d $PWD/test.scmail -c test.config -r test-rules -n >> test.scmail-deliver # must be stored in test.Mail2/spam/3 cat 5 | gosh -I.. ../scmail-deliver -d $PWD/test.scmail -c test.config -r test-rules diff test.Mail2/spam/2 test.Mail2/spam/3 || exit 1 gosh -ugauche.test -e '(test-end)' -Eexit gosh -ugauche.test -e '(test-start "scbayes for MH")' -Eexit scbayes_learn3 test.config --force scbayes_check test.config # must be stored in test.Mail2/spam/4 echo '(add-bayesian-filter-rule!)' > test.test-rules cat 4 | gosh -I .. ../scmail-deliver -d $PWD/test.scmail -c test.config -r test.test-rules >> test.scmail-deliver diff test.Mail2/spam/1 test.Mail2/spam/4 || exit 1 gosh -ugauche.test -e '(test-end)' -Eexit gosh -ugauche.test -e '(test-start "scmail-refile/scmail-deliver for Maildir")' -Eexit rm -rf test.scmail mkdir test.scmail $SCMAIL_REFILE -d $PWD/test.scmail -c test.config2 -r test-rules | tee test.log.normal2 # log files to stdout must be same diff test.log.dryrun2 test.log.normal2 check_nfiles test.Maildir test.Maildir2 # must be stored in spam folder. cat 5 | gosh -I.. ../scmail-deliver -d $PWD/test.scmail -c test.config2 -r test-rules >> test.scmail-deliver gosh -ugauche.test -e '(test-end)' -Eexit gosh -ugauche.test -e '(test-start "scbayes for Maildir")' -Eexit scbayes_learn3 test.config2 --force scbayes_check test.config2 # must be stored in spam folder. echo '(add-bayesian-filter-rule!)' > test.test-rules cat 4 | gosh -I .. ../scmail-deliver -d $PWD/test.scmail -c test.config2 -r test.test-rules >> test.scmail-deliver check_nfiles test.Mail2/spam test.Maildir2/spam gosh -I.. ../scbayes -c test.config2 --table-stat > test.stat1 gosh -ugauche.test -e '(test-end)' -Eexit gosh -ugauche.test -e '(test-start "scbayes --force")' -Eexit # without --force, the token table must not be changed. scbayes_learn test.config2 gosh -I.. ../scbayes -c test.config2 --table-stat > test.stat2 cmp test.stat1 test.stat2 || exit 1 # with --force, the token table must be changed. scbayes_learn test.config2 --force gosh -I.. ../scbayes -c test.config2 --table-stat > test.stat3 cmp test.stat1 test.stat3 > /dev/null && exit 1 gosh -ugauche.test -e '(test-end)' -Eexit gosh -ugauche.test -e '(test-start "scbayes --unlearn-spam/nonspam")' -Eexit rm -rf test.scmail mkdir test.scmail scbayes_learn test.config2 scbayes_unlearn test.config2 gosh -I.. ../scbayes -c test.config2 --table-stat > test.stat4 tail +2 test.stat4 > test.stat4.1 grep ' 0w/ .* 0m .* 0w/ .* 0m' test.stat4 > test.stat4.2 cmp test.stat4.1 test.stat4.2 || exit 1 # they must be empty gosh -I.. ../scbayes -c test.config2 --dump-table > test.table gosh -I.. ../scbayes -c test.config2 --dump-digest > test.digest cmp test.table /dev/null || exit 1 cmp test.digest /dev/null || exit 1 gosh -ugauche.test -e '(test-end)' -Eexit gosh -ugauche.test -e '(test-start "scmail-deliver: output must be empty")' -Eexit # scmail-deliver must not output anything. cmp test.scmail-deliver /dev/null || exit 1 gosh -ugauche.test -e '(test-end)' -Eexit gosh -ugauche.test -e '(test-start "scbayes --flush-interval")' -Eexit scbayes_learn test.config2 --table test.table-1.dbm --digest test.digest-1.dbm scbayes_learn test.config2 --flush-interval 1 --table test.table-2.dbm --digest test.digest-2.dbm # they must have the same content. gosh -I.. ../scbayes -c test.config2 --digest test.digest-1.dbm --dump-digest | sort | awk '{ print $ 1}' > test.digest-1 gosh -I.. ../scbayes -c test.config2 --digest test.digest-2.dbm --dump-digest | sort | awk '{ print $ 1}' > test.digest-2 gosh -I.. ../scbayes -c test.config2 --table test.table-1.dbm --dump-table | sort > test.table-1 gosh -I.. ../scbayes -c test.config2 --table test.table-2.dbm --dump-table | sort > test.table-2 cmp test.table-1 test.table-2 || exit 1 cmp test.digest-1 test.digest-2 || exit 1 gosh -ugauche.test -e '(test-end)' -Eexit gosh -ugauche.test -e '(test-start "umask")' -Eexit test `ls -ld test.Mail2/backup |awk '{print $1}'` = drwxr-x--- || exit 1 test `ls -l test.Mail2/backup/1 |awk '{print $1}'` = -rw-rw---- || exit 1 gosh -ugauche.test -e '(test-end)' -Eexit gosh -ugauche.test -e '(test-start "maildir refile: sys-rename is used?")' -Eexit inode_after=`ls -i test.Maildir2/from.foo/cur/1000000001.localhost:abc | awk '{print $1}'` test "$inode_before" -a "$inode_before" = "$inode_after" gosh -ugauche.test -e '(test-end)' -Eexit gosh -ugauche.test -e '(test-start "scmail-deliver to Maildir/new")' -Eexit cat 7 | gosh -I .. ../scmail-deliver -d $PWD/test.scmail -c test.config2 -r test.test-rules file=`tail -1 test.scmail/log |perl -nle 'print $1 if /refile: \(stdin\) -> (new\/.*)$/'` diff 7 test.Maildir2/$file || exit 1 gosh -ugauche.test -e '(test-end)' -Eexit exit 0 scmail-1.3.orig/AUTHORS0000644000175000017500000000026710061102401015336 0ustar gniibegniibe00000000000000Primary author: Satoru Takabayashi Bayesian filter: Shiro Kawai Patches from: OHASHI Akira Kimura Fuyuki scmail-1.3.orig/COPYING0000644000175000017500000000513010061102401015313 0ustar gniibegniibe00000000000000In short, scmail is distributed under so called "BSD license", that is, as far as you retain the copyrignt notice and disclaimer below, you can use, copy, modify and redistribute your modification freely. The formal term is specified in each copyright notices. Copyright and condition of use of main portion of the source: ----------------------------------------------------------------------------- Copyright (c) 2002-2004 Satoru Takabayashi, All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the authors nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ----------------------------------------------------------------------------- Copyright of scbayes.in, scmail/bayesian-filter.scm ------------------------- ;;; Copyright(C) 2003 by Shiro Kawai (shiro@acm.org) ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. scmail-1.3.orig/ChangeLog0000644000175000017500000012226610101460741016055 0ustar gniibegniibe000000000000002004-07-27 Satoru Takabayashi * scmail: 1.3 Released! * doc/embed.scm: New file. * doc/scmail.html.in: New file. * doc/scmail-ja.html.in: New file. * doc/Makefile: Simplified. * doc/scmail.rd: Removed. * doc/scmail-ja.rd: Removed. * doc/scbayes.rd: Removed. * doc/scbayes-ja.rd: Removed. * doc/reformat-html: Removed. * doc/html-noarchive: Removed. * Makefile: Adopt the above changes. 2004-07-26 Satoru Takabayashi * Makefile (VERSION): Bumped version number to 1.3. * scmail/util.scm (scmail-ports->file): Removed. * scmail/mail.scm (scmail-mail-query): Add optional parameter :multi-field based on the suggestion by Keiichiro Nagano [scmail:272]. * tests/test-rules.in (lambda): Add the test for that. * tests/7: New file. * tests/8: New file. * tests/Makefile (MAIL): Add them. 2004-06-23 Kimura Fuyuki * scmail/mail.scm (scmail-mail-read): Replace `port->string' with `get-remaining-input-string' since the former may cause "EOF in middle of a multibyte character" error. [scmail:280] 2004-06-13 Satoru Takabayashi * tests/scmail-commands: Use dummy-socket.scm to support the test for a host that does not has a running local MTA. * tests/dummy-socket.scm: New file. * scmail-deliver.in (main): Returns 75 to tells the MTA to re-try the delivery again if any errors is occurred. 2004-06-02 Satoru Takabayashi * doc/Makefile (update-web): Removed. (all): Use html-noarchive. 2004-03-17 Satoru Takabayashi * scbayes.in (learn-common): Use make-scmail-mailbox and scmail-mailbox-mail-list. (check-folder-dir): Use scmail-mailbox-folder->path. (collect-target-files): Take a new parameter mailbox. (collect-target-files-from-folders): Ditto. (check-folder): Use make-scmail-mailbox. (check-folder-path): Renamed from check-folder-dir. (check-spamness-in-folder): Renamed from check-folder. (check-spamness-of-mail): Renamed from check-mail. * scmail.scm (check-folder): Removed. (scmail-folder->directory): Removed. * scmail/mailbox.scm (scmail-mailbox-folder->path): Renamed from scmail-mailbox-folder->directory. * scmail.scm (scmail-mail-list): Removed. 2004-03-16 Satoru Takabayashi * scmail/util.scm (scmail-not-implemented-error): New function. * scmail.scm (copy-mail): Removed. (maildir-copy-mail): Ditto. (mh-copy-mail): Ditto. (move-mail): Ditto. (mh-move-mail): Ditto. (maildir-move-mail): Ditto. (mh-prepare-new-file): Ditto. (maildir-prepare-new-file): Ditto. (maildir-get-subdir): Ditto. (mh-last-mail-id): Ditto. (mh-dry-run-last-id): Ditto. (maildir-file): Ditto. (mh-file): Ditto. (maildir-make-sub-directories): Ditto. (maildir-generate-new-id): Ditto. (make-dest-directory): Ditto. (maildir-safe-write-mail): Ditto. * scmail/mail.scm (scmail-mail-copy): New method. (scmail-mail-move): Ditto. * scmail-refile.in (main-process): Use make-scmail-mail. * scmail-deliver.in (main-process): Use make-scmail-mail. * scmail/mail.scm (scmail-mail-add-type!): New function. (make-scmail-mail): Ditto. * scmail/maildir.scm: New file. * scmail/mh.scm: New file. * scmail/mail.scm: Added "scmail-" prefix to all exported methods. (write-object): Use class-name and class-of. * scmail.scm (scmail-mail-list): Renamed from scmail-file-list. * tests/scmail.scm (test-mailbox): Removed a test for scmail-file-list. * scmail.scm (mh-file-list): Removed. (maildir-file-list): Ditto. * scbayes.in (collect-target-files): Use scmail-mailbox-mail-list. * scmail.scm (scmail-main): Pass mailbox object to main-process. * scmail-refile.in (main-process): Use scmail-mailbox-mail-list. * tests/mailbox.scm: New file. * scmail/mailbox.scm: New file. 2004-03-12 Satoru Takabayashi * scmail.scm (maildir-safe-copy-mail): Take third parametre write-proc. (maildir-safe-write-mail): Renamed from maildir-safe-copy-mail. * scmail/util.scm (scmail-ports->file): New function. * tests/scmail-commands (file): Added a test for the size limit. * scmail/config.scm (): New slot: size-limit. * scmail.scm (mh-prepare-new-file): New function. (mh-copy-mail): Use it. (mh-move-mail): Use it. (maildir-prepare-new-file): New function. (maildir-copy-mail): Use it. (maildir-move-mail): Use it. (safe-copy-mail): New function. (mh-safe-copy-mail): New function. (prepare-new-file): New function. * scmail/mail.scm (mail-from-stdin?): Just check 'file instead of comparing to (standard-input-port). (): Use init-form instead of init-value for 'port. (mail-read): Set port-buffering to :none only if the port is (standard-input-port). 2004-03-11 Satoru Takabayashi * scmail: 1.2 Released! * scbayes.in (usage): Use sys-basename to modify *program-name*. * scmail.scm (show-help): Ditto. * NEWS: Updated. * doc/scmail.rd: Updated. * doc/scmail-ja.rd: Updated. 2004-03-10 Satoru Takabayashi * scmail.scm (maildir-generate-new-id): Removed. (maildir-generate-new-id): Simplified. (maildir-get-suffix): Removed. (maildir-copy-mail): Don't use maildir-get-suffix and use maildir-generate-new-id only if mail is from stdin. * scmail/mail.scm (mail-dry-run-mode?): New function. (mail-write): Use it. (mail-remove): Ditto. (mail-rename): Ditto. (mail-forward): Ditto. (mail-port): Renamed from mail->port. (mail-write): Modified to take a file name instead of port. * scmail-deliver.in (main-process): Use :dry-run-mode keyword to make object. * scmail-refile.in (main-process): Ditto. * scmail.scm (mh-move-mail): Use mail-rename instead of sys-rename. (maildir-move-mail): Ditto. (set-dry-run-mode!): Removed. * scmail/mail.scm (mail-rename): New function. (): New slot: dry-run-mode. 2004-03-09 Satoru Takabayashi * scmail.scm (scmail-main): New option --dry-run. Suggested by Fuyuki Kimra [scmail:264]. (show-help): Updated. (set-dry-run-mode!): New function. (scmail-log-to-file): New function. (scmail-main): Assign short options. 2004-03-03 Satoru Takabayashi * tests/scmail.scm: Added a new test for log files to ensure not to contain #. * scmail.scm (maildir-move-mail): Set removed? to #t. (mh-move-mail): Ditto. (move-mail): Don't set removed? field in the function. * Makefile (VERSION): Bumped version number to 1.2. 2004-03-02 Satoru Takabayashi * doc/scbayes.rd: Shorten the title. * doc/scbayes-ja.rd: Ditto. 2004-02-29 Satoru Takabayashi * dot.scmail/deliver-rules.sample.in: Added (use scmail.bayesian-filter) for using mail-is-spam?. * scmail.scm: Use autoload to load scmail.bayesian-filter only if it's necessary. Applied patch by Kimura Fuyuki [scmail:245]. (refile): Set 'removed? field to #t after calling move-mail. * scmail-deliver.in: Don't load scmail.bayesian-filter in the program. Applied patch by Kimura Fuyuki [scmail:245]. * scmail-refile.in: Ditto. 2004-02-21 Satoru Takabayashi * scmail.scm (refile): Dont' call mail-remove when move-mail is used. (check-folder): New function. (scmail-file-list): Use it. 2004-02-18 Satoru Takabayashi * tests/scmail.scm ("log files"): Added a test for handling of "new" subdir in Maildir. * scmail.scm (maildir-file): New parameter: subdir. (maildir-get-subdir): New function. (maildir-copy-mail): Use it. (maildir-move-mail): Ditto. (maildir-file-list): Collect files from "new" as well as "cur". 2004-02-16 Satoru Takabayashi * scmail/util.scm (scmail-set-program-name!): Use sys-basename. * scbayes.in (main): Added a condition for handling null folders. * scmail/bayesian-filter.scm.in (get-mime-boundary): Fixed incomplete string bug. Based on the patch from Kimura Fuyuki [scmail:228] (get-charset): Ditto. 2004-02-10 Satoru Takabayashi * scmail/config.scm (scmail-config-set-directory!): Don't use expand-path. * scmail.scm (mh-file-list): Use file-is-readable?. (maildir-file-list): Ditto. (mh-file): Simplified (Don't use exapand-path). (maildir-file): Ditto. (read-filter-rule): Ditto. * scmail-refile.in (main-process): Use file-exists?. [scmail:220]. 2004-02-07 Satoru Takabayashi * scmail: 1.1 Released! * Makefile (DIST): Added an ad hoc code for removing files should be generated at build time. [scmail:215] * tests/scmail-commands: Removed ^function. [scmail:215] * Makefile (VERSION): Bumped version number to 1.1. 2004-02-05 Satoru Takabayashi * scmail: 1.0 Released! * Makefile (check-gauche): New rule. * check-gauche.scm: New file. * Makefile (VERSION): Bumped version number to 1.0. * scmail/util.scm (scmail-check-gauche-version): Changed the required version of Gauche from 0.7.3 to 0.7.4.1. 2004-02-03 Satoru Takabayashi * tests/scmail-commands: Added a test for checking the use of sys-rename. * scmail.scm (refile): Use sys-rename. (move-mail): New function. (mh-move-mail): New function. (*maildir-seq*): Renamed from maildir-id. * scmail/config.scm (scmail-config-make-directory): Don't call sys-chmod any longer. * dot.scmail/config.sample: Added :umask. * scmail.scm (scmail-main): Call sys-umask to set umask. * scmail/config.scm (): New slot: umask. * scmail.scm (scmail-log): Add timezone offset to the time part. [scmail:176]. (redirect): Renamed from forward!. [scmail:206]. * scmail/bayesian-filter.scm.in: s/jp/ja/g [scmail:176]. 2004-02-02 Satoru Takabayashi * scmail.scm (valid-rule?): Allow "remove" command. (scmail-command-log): Made dest optional. * tests/scmail.scm (valid-rules): Added a test for "remove" command. * scmail.scm (remove): Write log. Suggested by ABE Yasushi [scmail:204]. * tests/test-rules.in (lambda): Added a test for "remove" command. * tests/Makefile (MAIL): Added 6. * tests/6: New file. * scmail.scm: Use define-method instead of define. (refile): Ditto. (forward-internal): Ditto. (forward): Ditto. (forward!): Ditto. (remove): New function. Suggested by ABE Yasushi [scmail:197]. (process-command): Support "remove" command. (apply-rule): Ditto. (process-command): Simplified. * scbayes.in (lock): Fixed the lock mechanism. create-directory* no longer raises an exception when the directory already exists. 2004-02-01 Satoru Takabayashi * scbayes.in (learn-common): Use with-error-handler to prevent accidental exit by an error (e.g. a file is removed while learning). (flush-interval): Set default to 0 (unlimited). 2004-01-30 Satoru Takabayashi * scbayes.in (learn-common): Use . for displaying the progress bar. * scmail/progress.scm (): bar-mark becomes initializable. * tests/scmail-commands: Add a test for scbayes --flush-interval. * scbayes.in (flush-interval): New parameter. (learn-common): Use it for periodic flushing of both DB files. (usage): Updated. (main): New option: --flush-interval. * scmail/bayesian-filter.scm.in (token-table-cache-flush): Use make-hash-table to reset the hash table. 2004-01-29 Satoru Takabayashi * scbayes.in (mail-digest): Renaed from file->md5-hex-digest. (learn-common): Use it. (mail-digest): Calculate MD5 digest using from/date/subject/message-id fields instead of the whole content. (mail-digest): Use digest-hexify. 2004-01-20 Satoru Takabayashi * Makefile (DIST): Add AUTHORS. * AUTHORS: New file. * doc/scbayes-ja.rd (index): Documentation updated. * doc/scbayes.rd: Documentation updated. 2004-01-19 Satoru Takabayashi * scmail/progress.scm (): New slot: title-width. (title): Use it. (show): Ditto. (): Rename a slot: bar-length -> bar-width. (initialize): Call show instead of show-progress. * scbayes.in (prepare-temporary-files): Sleep one second per 1 MB while copying a file in slow mode. (learn-common): Sleep one secound per 100 digests while flushing the digest cache in slow mode. (prepare-temporary-files): Check if a digest file is found while a token table file is not found. * scmail/bayesian-filter.scm.in (token-table-cache-flush): Count the number of keys in the cache and pass it to proc. * scbayes.in (prepare-temporary-files): Renamed from prepare-temporary-table-file and create a temporary digest file. (temporary-digest-file): New function. (open-digest-db): Take a parameter: file. (swap-files): Renamed from swap-table-file and use signal handlers to ignore SIGINT SIGHUP SIGTERM. (swap-files): Handle a temporary digest file as well as a token table file. (main): New option: --slow. (slow?): New parameter. (learn-common): Sleep one second per file and also sleep one secound per 100 keys while flushing the token table cache in slow mode. 2004-01-18 Satoru Takabayashi * scbayes.in (main): Rename options: --learned -> --digest --dump-learned -> --dump-digest. (usage): Updated. (add-to-digest-cache!): New function. (flush-digest-cache): New function. (learned?): Refer (digest-cache) as well as (digest-db). * dot.scmail/config.sample (:digest): Renamed from :learned. * scmail/config.scm (): Rename a slot: learned -> digest. * scbayes.in (learn-common): Clean a temporary table file if the processing is aborted. (learn-files): Returns number of learned files. (learn-common): Show a summary at the end of the processing. (learned-cache): New variable. * scmail/progress.scm (show): Add an extra space to the end of format. 2004-01-16 Shiro Kawai * scbayes.in (update-db) : removed --update-db option. It is obsolete and useless now. * scmail/bayesian-filter.scm.in (tokenize-port): count multibyte chars and ascii chars, to determine whether the parsed mail is in japanese or not heuristically. (tokenize-email, tokenize-message, tokenize-header, tokenize-body): use a special charset name "none" to indicate the fallback parsing after the default parsing scheme failed. * doc/scbayes-ja.rd : revised to reflect the recent changes. * doc/scbayes.rd : added contents. 2004-01-16 Satoru Takabayashi * scmail/progress.scm (initialize): Call port-buffering to turn off buffering. (show-progress): Update the progress bar if one sec. elapsed. * scmail.scm (scmail-main): Use with-output-to-file to realize quiet-mode. (scmail-main): New parameter: quiet-mode. * scmail/config.scm (scmail-config-set-quiet-mode!): Removed. (scmail-config-quiet-mode?): ditto. * scmail/util.scm (scmail-wformat): Don't refer (scmail-config-queit-mode?) any longer. * scmail/progress.scm (): Change the default value of port to (current-output-port). (): Removed. * scbayes.in: Don't use scmail-print/scmail-format/scmail-make-progress any longer. * scmail/util.scm (scmail-print): Removed. (scmail-format): Ditto. (scmail-make-progress): Ditto. * scbayes.in (dump-table): New function. (dump-learned): New function. (main): New option: --dump-table, --dump-learned, --learned. (usage): Updated. (learn-common): Accept directories as well as folders. (collect-target-files-from-folders): New function. (collect-target-files): New function. (check-folder): use it. (check-folder-dir): Accept a directory in absolute path. (learn-common): Call scmail-config-make-directory in the function. (main): Use with-output-to-file to realize quiet-mode. * scmail/bayesian-filter.scm.in: Remove $ Id $ line. (token-table-index-of-spam): Renamed from spam-table. (token-table-index-of-nonspam): Renamed from nonspam-table. * scbayes.in: Remove $ Id $ line. * scmail/progress.scm (progress-finish!): Renamed from progress-finish. (progress-set!): Ditto. (progress-inc!): Ditto. (progress-set!): Removed because it has not been used. * scmail/bayesian-filter.scm.in (token-table-collect-words): Renamed from collect-words and take a main instead of a file as a parameter. (token-table-discard-words): Ditto. * scbayes.in (learn-common): Show a progress bar for "write" in this function instead of in bayesian-filter.scm. * scmail/bayesian-filter.scm.in (token-table-cache-length): New function. * scbayes.in (learn-common): Use token-table-cache-flush. * scmail/bayesian-filter.scm.in (load-token-table-if-not-loaded): Use errorf. (close-token-table): Don't flush the hash table in this function. (token-table-cache-flush): New function. * scbayes.in (check-mail): Don't use test-spamness-of-file any longer. (test-spamness-of-files): Moved from bayesian-filter.in. * scmail/bayesian-filter.scm.in (table-for-each): New function. (special-key-prefix): New function. (*message-count-key*): Use it. (total-token-count): Use it. (simple-stat): Removed. (message-count): Be exported. (total-token-count): Ditto. (token-table-languages): Renamed from *languages*. (token-table-number-of-values): Renamed from *num-values*. (token-table-for-each): Renamed from table-for-each. (token-table-special-key-prefix): Renamed from special-key-prefix. (token-table-message-count): Renamed from message-count. (token-table-token-count): Renamed from total-token-count. (test-spamness-of-file): Removed. * tests/scmail-commands: Add test for scbayes --unlearn. * scbayes.in (usage): Updated. (main): New option: --unlearn-nonspam and --unlearn-spam. (learn-common): Fix the skip? condition. * tests/bayesian-filter.scm.in (get-total-token-count): Add test for discard-words. * scmail/bayesian-filter.scm.in (total-token-count): Renamed from count-tokens. (message-count): New method. (simple-stat): Never call load-token-table-if-not-loaded. 2004-01-15 Shiro Kawai * Makefile (install): use '-f' option of cp to avoid an error when installed by non-priviledged user. * scmail/bayesian-filter.scm.in (tokenize-header): use tokenize-iso8859 when charset is us-ascii, to avoid "EOF encountered during reading multibyte character" error. 2004-01-15 Satoru Takabayashi * scmail/bayesian-filter.scm.in (process-words): New function. (collect-words): Use it. (discard-words): New function. (delete-token): New function. (process-token): New function. (add-token): Use it. (minus->zero): New function. (close-token-table): Use it. (close-token-table): Set token-table to #f. (simple-stat): Use load-token-table-if-not-loaded. (test-spamness-of-file): Ditto. (test-spamness-of-files): Ditto. (close-token-table): Never use minus->zero. (safe-inc!): New syntax. (process-words): Use safe-inc!. (process-token): Ditto. (with-token-table): Returns nothing. (message-count-of-type): Renamed from message-count. (process-token): Fix the bug of counting total-token-count redundantly. (process-token): Simplified. (safe-inc!): Removed. (close-token-table): Use minus->zero. (): Remove a slot: total-token-count. (open-token-table): Remove total-token-count related code. (*total-token-count-key*): Removed. (count-tokens): New function. (simple-stat): Use it. * scbayes.in (learn-common): New function. (learn): Use it. (unlearn): New function. (not-learned?): New function. (delete-from-learned-db!): New function. * tests/scmail-commands: Add test for scbayes --force. * scbayes.in (learned?): New function. (add-to-learned-db!): New function. (file->md5hex-digest): New function. (open-learned-db): New function. (force-learn?): New parameter. (learn): Use them. (learned-file): New function. (*learned-file*): New variable. (main): New option: --force. (usage): Updated. * scmail/progress.scm (>): Simplified. * scmail/util.scm (scmail-format): New function. * scmail/bayesian-filter.scm.in: Use scmail-format and scmail-print for --quiet option. * scbayes.in (update-db): Use scmail-format and scmail-print for --queiet option. (usage): Change exit code to zero (GNU command style). * scmail/bayesian-filter.scm.in (load-token-table-if-not-loaded): Use scmail-eformat. * scbayes.in (check-folder-dir): Use scmail-eformat. (check-mail): Ditto. * scmail/util.scm (scmail-xformat): Renamed from scmail-xprintf. (scmail-wformat): Renamed from scmail-wprintf. (scmail-dformat): Renamed from scmail-dprintf. (scmail-eformat): Renamed from scmail-eprintf. * scmail.scm (scmail-log): Use format and take optional arguments for it. (scmail-error-log): Ditto. * scbayes.in (scmail-main): Use scmail-check-gauche-version. * scbayes.in (main): Use scmail-check-gauche-version. * scmail/util.scm (scmail-check-gauche-version): New function. * scmail/config.scm: Remove an old path of token-table.dbm. * tests/scmail-commands: Add tests for scbayes. * scbayes.in (main): Change exit status according to the result. (check-mail): Returns always 0. (check-folder): Returns the number of incorrect answers. (table-stat): Returns always 0. (update-db): Returns always 0. * scmail/config.scm (scmail-config-read): Simplified. * scmail/util.scm (scmail-xprintf): Simplified. (scmail-wprintf): Ditto. (scmail-eprintf): Ditto. (scmail-dprintf): Ditto. (scmail-make-progress): Ditto. * dot.scmail/deliver-rules.sample.in: Renamed from dot.scmail/deliver-rules. * Makefile (dot.scmail/deliver-rules.sample): new rule. * tests/mail.scm: Check send-mail whether or not it allows incomplete string. [scmail:147] [scmail:149] 2004-01-14 Satoru Takabayashi * scmail/mail.scm: Support incomplete string. [scmail:147] by Shiro. * scmail/bayesian-filter.scm.in (test-spamness-of-file): Returns prob. (test-spamness-of-files): Returns the number of incorrect answers. * tests/Makefile (TESTS): Add bayesian-filter.scm * scmail/bayesian-filter.scm.in (spamness-of-mail): Call load-token-table-if-not-loaded. (spamness-of-word): Ditto. (load-prob-tables): Returns #t. * Makefile (tests/test-rules): Removed. * scmail/bayesian-filter.scm.in: Returns total-token-count. (load-token-table-if-not-loaded): Reopen if db is closed. 2004-01-13 Shiro Kawai * scmail/bayesian-filter.scm.in (tokenize-port): Make tokenizer's character sets work on any internal character encodings. 2004-01-14 Satoru Takabayashi * COPYING: New file. Based on Gauche's. * scmail: Change the licence: GPL -> BSD. [scmail:142]. * Makefile (dist-scbayes): Removed. * Makefile.scbayes (install): Removed. [scmail:143]. * tests/progress.scm: New file. * doc/scmail.rd (index): Updated. * doc/scmail-ja.rd: Updated. * tests/scmail-commands: New file. * scmail/mail.scm (mail-read): Use filter to avoid old Gauche versions bug. rfc822-header->list returns (#t #t). * Makefile (tests/test-rules): New rule. * tests/test-rules.in: New file. * Makefile (scmail/bayesian-filter.scm): Use codeconv.scm. (tests/scmail.scm): New rule. * codeconv.scm: New file. * scmail.scm (scmail-main): Simplified. (mh-copy-mail): Fix the argument for mh-last-mail-id. (mh-last-mail-id): Fix the return value bug. * scmail-deliver.in (main-process): Simplified. * scmail-refile.in (main-process): Simplified. * scmail.scm (scmail-filter): Remove second parameter: filter-rules. * tests/5: New file. * tests/4: New file. * tests/3: New file. * tests/Makefile (mh-mailbox): New rule. (maildir-mailbox): New rule. 2004-01-13 Satoru Takabayashi * scmail/bayesian-filter.scm.in: New fie. * Makefile (scmail/bayesian-filter.scm): Generate it at build time. Patch by ABE Yasushi [scmail:137]. * scmail/mail.scm (mail-name): Preserve file-name info. Suggested by Shiro Kawai [scmail:135]. (mail-read): Fix 'body info. * scmail.scm (valid-rule?): New function. (add-filter-rule!): Use it. (add-bayesian-filter-rule!): Simplified. (scmail-filter): Add error handling. (bayesian-filter): New function. (add-bayesian-filter-rule!): Use it. * tests/Makefile (TESTS): Add scmail.scm. * tests/scmail.scm: New file. * scmail/config.scm (): Remove a slot: stdout-report. * scmail.scm (scmail-log): Not to refer stdout-report slot. * scmail-deliver.in (main-process): Use scmail-config-set-quiet-mode!. * scmail-refile.in (main-process): Not to use stdout-report slot. * scmail.scm (scmail-main): New option: --scmail-dir. (show-help): Updated. * scbayes.in (main): New option: --scmail-dir. (usage): Updated. * scmail/config.scm (scmail-config-set-directory!): New function. (scmail-config-directory): New parameter. (build-config-path): New function. (scmail-config-default-file): Use it. (choose): Ditto. (scmail-config-get-path): Ditto. (initialize): Simplified. * tests/Makefile (TESTS): Add mail.scm and util.scm, config.scm. * tests/util.scm: New file. * scmail/util.scm (scmail-wprintf): Fix the infinite recursion bug. * tests/syntax.scm: Renamed from check-syntax.scm * scmail/mail.scm (scmail.mail): Not to export mail-read. (send-mail): Return #t if successful. * tests/check-syntax: Removed. * tests/Makefile (check): Modified to use gosh for testing. * tests/mail.scm: New file. * scmail/mail.scm (mail-from-stdin?): Refer (standard-input-port) instead of (current-input-port). * scmail.scm (scmail-main): New option: --quiet. (scmail-log): Use scmail-config-queit-mode?. * scmail/util.scm (scmail-set-program-name!): Renamed from scmail-set-program-name. * scmail/config.scm (scmail-config-set-verbose-mode!): Renamed from scmail-config-set-verbose-mode. (scmail-config-set-quiet-mode!): Renamed from scmail-config-set-quiet-mode. * scmail.scm (scmail): Export scmail-log and forward! 2004-01-12 Satoru Takabayashi * scmail.scm (make-dest-directory): Remove a parameter: mailbox. (copy-mail): Ditto. (mh-copy-mail): Ditto. (maildir-copy-mail): Ditto. (foward!): New function. (forward-internal): New function. (forward): Use it. (forward!): Ditto. (process-command): Add forward!. * scmail/mail.scm (scmail.mail): Export mail-forward. Reported by ABE Yasushi [scmail:129]. * scmail.scm (mh-file): Restored. Reported by ABE Yasushi [scmail:127]. (maildir-file): Ditto. 2004-01-10 Satoru Takabayashi * scmail/config.scm (scmail-config-make-directory): Use #o notation. * scmail.scm (read-black-list-file): Removed. (scmail-main): No longer use black-list. * scmail/config.scm (): Remove a slot: black-list. (initialize): Ditto. (choose): Ditto. * dot.scmail/config.sample: Remove black-list. * Makefile (check): New rule. * tests/Makefile: New file. * tests/check-syntax: New file. * tests/check-syntax.scm: New file. * dot.scmail/deliver-rules.sample: New file. * dot.scmail/refile-rules.sample: New file. * dot.scmail/config.sample: New file. * Makefile (DIST): Remove scmailrc*.sample (install): Copy dot.scmail files. (dist): Include dot.scmail files. * scmail.scm (scmail-folder->directory): Renamed from folder->directory. * scbayes.in (check-mail): Use test-spamness-of-file. (check-folder): Use test-spamness-of-files. (check-folder-dir): Use scmail-folder->directory. (folder-dir): Removed. (mailbox-type): Removed. (mailbox-dir): Removed. * scmail/bayesian-filter.scm (test-spamness-of-file): Renamed from test-spamness-of-mail. (test-spamness-of-files): Renamed from test-spamness-in-folder and modify parameters.. * scbayes.in (collect-target-files): Removed. * scmail-refile.in (main-process): Simplified. * scmail.scm (scmail-file): Removed. (mh-file): Removed. (maildir-file): Removed. (scmail-file-list): Take folder instead of directory. (mh-file-list): Ditto. (maildir-file-list): Ditto. (folder->directory): New function. * scbayes.in (lock): Use create-directory* instead of sys-mkdir. * scmail/config.scm (scmail-config-make-directory): Use create-directory* instead of sys-mkdir. * scmail.scm (mh-file-list): Simplified. (maildir-make-sub-directories): Ditto. (maildir-generate-new-id): Use inc!. * scmail/util.scm (scmail-dprintf): Use scmail-config-verbose-mode?. * scmail.scm (scmail-main): Use verbose instead of debug. (show-help): Updated. * scbayes.in (main): Use verbose instead of debug. (usage): Updated. * scmail/config.scm (): Rename slot: debug-mode -> verbose-mode. (scmail-config-set-verbose-mode): Renamed from debug to verbose. (scmail-config-verbose-mode?): Ditto. * scmail/mail.scm (mail-read): Don't parse the content if it is empty. * scmail/bayesian-filter.scm (load-token-table-if-not-loaded): Fixed slot name: scbayes-table-file -> token-table. * scmail.scm: Use scmail-set-program-name. * scbayes.in (lock): Fixed the mode for sys-mkdir. * scmail.scm (scmail-main): Use scmail-config-make-directory. * scmail/config.scm (scmail-config-make-directory): New function. * scmail/config.scm (scmail-config-default-file): Use choose. (scmail-config-get-path): New function. * scmail.scm: Use scmail-config-get-path. (scmail-log): Ditto. * scmail/config.scm (scmail-config-default-file): ~/.scmailrc -> ~/.scmail/config. * scmail.scm (scmail-main): Remove an option: --kill. * scmail-deliver.in (main): Simplified. * scmail-refile.in (main): Simplified. * scmail/config.scm (): Rename slot: scbayes-table-file -> token-table. (): New slot: learned, black-list, white-list. * scbayes.in (learn): Take folders instead of a single folder. * scmail/progress.scm (time-difference->real): New function. * scbayes.in (lock): New function. (collect-target-files): New function. (learn): Use them. * scmail/bayesian-filter.scm (collect-words): Simplified. Take a file instead of a folder as a parameter. 2004-01-09 Satoru Takabayashi * scbayes.in (prepare-temporary-table-file): Use make-progress. * scmail/util.scm (scmail-make-progress): Moved from bayesian-filter.scm. * scmail/bayesian-filter.scm (scmail-make-progress): Renamed from make-progress. * scbayes.in (main): New option: --quiet. (usage): Updated. * scmail/config.scm (scmail-config-quiet-mode?): New function. (scmail-config-set-quiet-mode): New function. (): New slot: quiet-mode. * scmail/bayesian-filter.scm (collect-words): Use . (make-progress): New function. (collect-words): Use make-progress. (make-progress): Use scmail-config-queit-mode. (close-token-table): Use make-progress. * scmail/util.scm (scmail-dprintf): Use scmail-config-debug-mode?. * scmail/config.scm (scmail-config-debug-mode?): New function. * scbayes.in (main): Use scmail-config-set-debug-mode. * scmail.scm (main-process): Use scmail-config-set-debug-mode. * scmail/config.scm (scmail-set-debug-mode): Moved from util.scm. (scmail-config-set-debug-mode): Renamed from scmail-set-debug-mode. * scmail/util.scm (debug-mode): Removed. (scmail-dprintf): Use scmail-config. * scmail/config.scm (write-object): Simplified. (): New slot: debug-mode. * scmail/progress.scm: New file. * scmail/bayesian-filter.scm (tokenize-body): Use scmail-dprintf instead of report. (tokenize-body): Ditto. (tokenize-email): Use scmail-wprintf instead of report. (report): Removed. * scbayes.in (main): New option: --debug. * scmail.scm (scmail-main): New option: --debug. (show-help): Updated. * scmail/util.scm (scmail-dprintf): New function. (scmail-set-debug-mode): New function. (debug-mode): New parameter. * scmail/bayesian-filter.scm (tokenize-header): Use mail-decode-field. * scmail/mail.scm (mail-decode-field): Renamed from decode-field. (mail-read): Use mail-decode-field. * scmail.scm (*last-match-data*): Parameterized. (*match-data-replace-rule*): Ditto. (*filter-rules*): Ditto. (replace-param): Renamed from replace-folder-name. (copy): Use it. (refile): Ditto. (forward): Ditto. * scbayes.in (main): New option: --config. (usage): Updated. (read-config): Removed. (mailbox-dir): Use scmail-config. (mailbox-type): Ditto. (table-file): Ditto. * scmail/config.scm (scmail-default-config-file): New function. * scmail-deliver.in (main): Simplified. * scmail-refile.in (main): Simplified. * scbayes.in (main): Use scmail-set-program-name. (learn): Use scmail-wprintf and scmail-eprintf. * scmail.scm (scmail-main): Use scmail-set-program-name. * scmail/util.scm (program-name): New parameter. (scmail-set-program-name): New function. (scmail-eprintf): Ditto. (scmail-wprintf): Ditto. * scmailrc-deliver.sample: Update examples. * scmail.scm (process-rule): Simplified. (*last-match-data*): New global variable. (replace-folder-name): Use it. (match-rule?): New function. (object-apply): Make applicable. * scmail/bayesian-filter.scm (decode-field): Removed. * scmail/config.scm (): Remove a slot: charcode. * scmailrc-refile.sample: Update examples. * scmail/bayesian-filter.scm (tokenize-body): Commented out "skipping ..." message. * scmail.scm (scmail-file): Renamed from scmail-file-name. (mh-file): Renamed from mh-file-name. (maildir-file-name): Renamed from maildir-file-name. * scmail/mail.scm (mail-read): Eliminate an unnecessary call of read-content. 2004-01-08 Satoru Takabayashi * scmail/mail.scm (): New slot: file. * scmail-refile.in (main): Simplified. * scmail-deliver.in (main-process): Simplified. * scmail/mail.scm (): Remove a slot: charcode. * scmail/bayesian-filter.scm (test-spamness-of-mail): Use class. (test-spamness-in-folder): Change a variable name: email -> file-name. * scmail.scm (add-bayesian-filter-rule!): New method. * scmail/bayesian-filter.scm (load-token-table-if-not-loaded): New function. (mail-is-spam?): Use load-token-table-if-not-loaded. * scmail.scm: Use expand-path and build-path instead of expand-file-name throughout the file. * scmail/config.scm: Use expand-path instead of expand-file-name throughout the file. * scmail/util.scm (safe-rxmatch): Moved from scmail.scm. (expand-file-name): Removed. * scmail.scm (*filter-rules*): Renamed from global-filter-rules. (*match-data-replace-rule*): Renamed from global-match-data-replace-rule. * scbayes.in (*from*): Removed. (*to*): Removed. * scmail-refile.in (main-process): Simplified. * scmail.scm: Use scmail-config function instead of config variable throughout the file and remove unnecessary parameters for all functions. (scmail-file-list): Renamed from file-list. (scmail-file-name): Renamed from file-name. (copy): New function. (refile): Ditto. (forward): Ditto. * scmail/config.scm (scmail-config-read): Renamed from read-config-file. (scmail-config): New function. * scmail/util.scm: New file. * scmail.scm (copy-mail): Dispatch according to 'mailbox-type. (file-name): Ditto. (file-list): Ditto. (initialize): Simplified. (): Remove slots: copy-mail, file-list, file-name. (): New parameter: scbayes-table-file. * scmailrc.sample: New parameter: scbayes-table-file. * scmail.scm (scmail-filter): Renamed from mail-filter. (copy-mail): Renamed from mail-copy. * scmail-refile.in: Use scmail.mail module. * scmail-deliver.in: Use scmail.mail module. * scmail/mail.scm: New file. * scmail/bayesian-filter.scm (mail-is-spam?): Take mail instead of file. (spamness-of-mail): Ditto. (tokenize-email): Ditto. (tokenize-mime): Rename the first parameter: file -> file-name. (tokenize-body): Ditto. (tokenize-message): Ditto. (collect-words): Use class. * scmail.scm: Use ref instead of slot-ref throughout the file. 2004-01-07 Satoru Takabayashi * scbayes.in (do-read-lock): New function. (do-write-lock): Ditto. (port-is-write-locked?): Ditto. (temporary-table-file): Ditto. (prepare-temporary-table-file): Ditto. (swap-table-file): Ditto. (learn): Use them. (lock-file): New function. (file-is-write-locked?): Removed. (do-write-unlock): Ditto. (do-write-lock): Ditto. (learn): Do simple locking with sys-mkdir. 2004-01-06 Satoru Takabayashi * scbayes.in (main): Modified --learn-nonspam and --learn-spam options accept one or more folders using supplemental functions called get-folders and learn-lnternal. (usage): Updated. 2004-01-05 Satoru Takabayashi * scmail.scm (): New slot: spam. "junk" slot is now for backward compatibility. (read-kill-file): Use "spam" slot instead of "junk". (write-object): Ditto. (mail-read): Use decode-field to decode a field. * scmailrc.sample: s/junk/spam/g. * doc/scmail.rd: Document updated. * doc/scmail-ja.rd: Document updated. * Makefile (VERSION): Bumped version number to 0.3pre1. 2003-12-28 Shiro Kawai * scmail/bayesian-filter.scm: use srfi-1 explicitly. (Patch from Kimura Fuyuki). 2003-12-09 Shiro Kawai * scmail/bayesian-filter.scm (get-mime-boundary): Fixed regexp of finding MIME boundary (pointed by Kimura Fuyuki). * scmail.scm (mail-read): Reads message body as a binary block to avoid character-encoding related error. Also changed to use rfc.822 module to parse the message headers. 2003-11-25 OHASHI Akira * Makefile (SITELIBDIR): New macro. (install): Use it. 2003-11-18 Satoru Takabayashi * scbayes.in: Apply a patch by OHASHI Akira . (learn): Support Maildir. (check-folder): Ditto. (main): Ditto. * scmail/bayesian-filter.scm: Apply a patch by OHASHI Akira . (collect-words): Support Maildir. (test-spamness-in-folder): Ditto. 2003-05-08 Satoru Takabayashi * scmail.scm (read-kill-file): Fix a bug. (forgot to use , to evaluate an expression) 2003-04-23 Shiro Kawai * scbayes.in: Incorporated scbayes source * scmail/bayesian-filter.scm: Incorporated scbayes source * doc/scbayes.txt: Added * Makefile: Integrated scbayes 2003-04-21 Satoru Takabayashi * scmail.scm: Fix the malformed field bug. - Thanks to Shiro Kawai for the patch. [scmail:31] 2003-04-16 Satoru Takabayashi * scmail.scm (scmail): Export mail-write. (maildir-get-suffix): New function. (maildir-mail-copy): Preserver suffix info such as ":2,S" (read-kill-file): Junk files go to (slot-ref config 'junk). (): New field: junk. 2003-03-23 Satoru Takabayashi * scmail.scm (safe-rxmatch): New function. Use safe-rxmatch instead of rxmatch throughout the file. 2003-03-21 Satoru Takabayashi * scmail: 0.2 Released! 2003-03-19 Satoru Takabayashi * scmail.scm (set-match-data-replace-rule!): New function. (replace-folder-name): Use global-match-data-replace-rule. 2003-03-18 Satoru Takabayashi * scmail.scm (mail-separate): Allow a mail with an empty body. - Thanks to Shiro Kawai for the patch. (mh-mail-copy): Renamed from mail-copy. (mh-last-mail-id): Renamed from last-mail-id. (mh-file-list): Renamed from file-list. (mh-file-name): Renamed from file-name. (mail-copy): Be dispatch function. (initialize): Initialize dispatch functions. (file-list): New function. (file-name): New function. (maildir-generate-new-id): New function. (maildir-file-name): New function. (maildir-mail-copy): New function. (maildir-file-list): New function. (maildir-safe-mail-copy): New function. (command-copy): Modify the log message. (command-refile): Ditto. 2002-10-24 Satoru Takabayashi * scmail: 0.1 Released! * scmail.scm (scmail-main): Add --help option. (show-help): New function. 2002-10-23 Satoru Takabayashi * scmail.scm (): Use gauche-character-encoding to determine the internal character encoding. (read-filter-rule): Use with-error-handler to handle a broken filter rule. (scmail-command-log): New function. (scmail-log): Rewritten. (read-kill-file): Add facility for error logging. (read-filter-rule): Ditto. 2002-10-16 Satoru Takabayashi * scmail.scm (send-mail): Fix the period at the beginning of line handling. 2002-10-10 Satoru Takabayashi * scmail.scm (mail-read): Snip the first "From " line in the function. (mail-separate): Don't snip the first "From " line in the function. 2002-10-09 Satoru Takabayashi * scmail.scm (filter): Reinvent it because filter in srfi-1 module is too slow. * Makefile: Create scmail-deliver from scmail-deliver.in. Create scmail-refile from scmail-refile.in. * scmail-deliver: Removed. * scmail-refile: Removed. * scmail-deliver.in: New file. * scmail-refile.in: New file. * scmail-refile (main-process): Set (config 'stdout-report) to #t. * scmail.scm (read-kill-file): Use expand-file-name. (read-config-file): Ditto. (read-filter-rule): Ditto. (scmail-log): Ditto. (): Add new field: stdout-report 2002-09-26 Satoru Takabayashi * scmail.scm (decode-field): Use quoted-printable-decode-string if necessary. 2002-09-25 Satoru Takabayashi * scmail.scm (regexp?): Abolished. Use Gauche's one. 2002-09-20 Satoru Takabayashi * scmailrc-kill.sample: New file. 2002-09-19 Satoru Takabayashi * scmailrc-deliver.sample: New file. * scmailrc-refile.sample: New file. * scmailrc.sample: New file. * scmail-deliver: New file. * scmail-refile: New file. 2002-09-10 Satoru Takabayashi * scmail.scm: Development started! scmail-1.3.orig/Makefile0000644000175000017500000000531110101462322015727 0ustar gniibegniibe00000000000000VERSION = 1.3 PREFIX = /usr/local BINDIR = $(PREFIX)/bin DATADIR = $(PREFIX)/share/scmail SITELIBDIR = `gauche-config --sitelibdir` DIST = AUTHORS \ COPYING \ ChangeLog \ Makefile \ README \ NEWS \ scmail-refile.in \ scmail-deliver.in \ scbayes.in \ scmail.scm \ codeconv.scm \ check-gauche.scm TARGET = scmail-deliver scmail-refile scbayes \ scmail/bayesian-filter.scm \ dot.scmail/deliver-rules.sample all: check-gauche $(TARGET) update-doc update-doc: cd doc && make check-gauche: gosh -I. check-gauche.scm scmail/bayesian-filter.scm: scmail/bayesian-filter.scm.in rm -f scmail/bayesian-filter.scm gosh codeconv.scm scmail/bayesian-filter.scm.in > \ scmail/bayesian-filter.scm chmod -w scmail/bayesian-filter.scm dot.scmail/deliver-rules.sample: dot.scmail/deliver-rules.sample.in rm -f dot.scmail/deliver-rules.sample gosh codeconv.scm dot.scmail/deliver-rules.sample.in > \ dot.scmail/deliver-rules.sample chmod -w dot.scmail/deliver-rules.sample scmail-deliver: scmail-deliver.in Makefile rm -f scmail-deliver GOSH=`which gosh` && \ sed -e "s!@GOSH@!$$GOSH!g" \ scmail-deliver.in > scmail-deliver.tmp mv scmail-deliver.tmp scmail-deliver chmod 555 scmail-deliver scmail-refile: scmail-refile.in Makefile rm -f scmail-refile GOSH=`which gosh` && \ sed -e "s!@GOSH@!$$GOSH!g" \ scmail-refile.in > scmail-refile.tmp mv scmail-refile.tmp scmail-refile chmod 555 scmail-refile scbayes: scbayes.in Makefile rm -f scbayes GOSH=`which gosh` && \ sed -e "s!@GOSH@!$$GOSH!g" \ scbayes.in > scbayes.tmp mv scbayes.tmp scbayes chmod 555 scbayes clean: rm -f $(TARGET) check: all cd tests && make check install: mkdir -p $(BINDIR) mkdir -p $(DATADIR) mkdir -p $(SITELIBDIR)/scmail mkdir -p $(DATADIR)/dot.scmail cp -fp scmail-deliver scmail-refile scbayes $(BINDIR) cp -fp dot.scmail/*.sample $(DATADIR)/dot.scmail cp -fp scmail.scm $(SITELIBDIR) cp -fp scmail/*.scm $(SITELIBDIR)/scmail dist: all rm -rf scmail-$(VERSION) rm -f scmail-$(VERSION).tar.gz mkdir scmail-$(VERSION) mkdir scmail-$(VERSION)/doc mkdir scmail-$(VERSION)/scmail mkdir scmail-$(VERSION)/dot.scmail mkdir scmail-$(VERSION)/tests cp -p $(DIST) scmail-$(VERSION) cp -p doc/embed.scm doc/Makefile doc/scmail*.html.in doc/scbayes*.html \ scmail-$(VERSION)/doc cp -p scmail/*.scm scmail/*.in scmail-$(VERSION)/scmail cp -p dot.scmail/*.sample dot.scmail/*.in \ scmail-$(VERSION)/dot.scmail cp -p tests/Makefile tests/*.scm tests/[1-9] \ tests/*.in tests/scmail-commands \ scmail-$(VERSION)/tests for i in `find scmail-$(VERSION) -type f -print`; do \ test -e $$i -a -e $$i.in && rm -f $$i; true; \ done tar zvcf scmail-$(VERSION).tar.gz scmail-$(VERSION) rm -rf scmail-$(VERSION) scmail-1.3.orig/README0000644000175000017500000000024010061102401015135 0ustar gniibegniibe00000000000000scmail - a mail filter writtein in Scheme. The latest version is available at: -- Satoru Takabayashi scmail-1.3.orig/NEWS0000644000175000017500000000150010101220753014762 0ustar gniibegniibe00000000000000Overview of Changes in scmail 1.3 - 2004-07-27 * Multiple occurrences of fields having the same name are now supported (ex. Delivered-To:). * Other small modifications have been also made. Overview of Changes in scmail 1.2 - 2004-03-11 * scmail-refile/scmail-deliver --dry-run is supported. * Short command line options are supported. Overview of Changes in scmail 1.1 - 2004-02-07 * Packaging problems is fixed. Overview of Changes in scmail 1.0 - 2004-02-05 * A spam filter called scbayes is now included * Names of configuration files are changed. * Writing a rule using lambda becomes easy. * Many codes are rearranged. * A test suite is prepared (make check) Overview of Changes in scmail 0.2 - 2003-03-21 * Maildir is now supported. Overview of Changes in scmail 0.1 - 2002-10-24 * The initial version is released. scmail-1.3.orig/scmail-refile.in0000644000175000017500000000265510061102401017335 0ustar gniibegniibe00000000000000#! @GOSH@ ;;; -*- scheme -*- ;;; ;;; scmail - a mail filter written in Scheme ;;; ;;; Copyright (C) 2002-2004 Satoru Takabayashi ;;; All rights reserved. ;;; This is free software with ABSOLUTELY NO WARRANTY. ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. ;;; (use scmail) (use scmail.config) (use scmail.mail) (use scmail.mailbox) (use file.util) (define (main-process mailbox target-folder dry-run-mode) (for-each (lambda (file) (if (file-exists? file) (let* ((mailbox-type (ref (scmail-config) 'mailbox-type)) (mail (make-scmail-mail mailbox-type :file file :mailbox mailbox :dry-run-mode dry-run-mode))) (scmail-filter mail)))) (scmail-mailbox-mail-list mailbox target-folder))) (define (main args) (scmail-main args main-process 'refile-rules #f) 0) scmail-1.3.orig/scmail-deliver.in0000644000175000017500000000243110062702241017522 0ustar gniibegniibe00000000000000#! @GOSH@ ;;; -*- scheme -*- ;;; ;;; scmail - a mail filter written in Scheme ;;; ;;; Copyright (C) 2002-2004 Satoru Takabayashi ;;; All rights reserved. ;;; This is free software with ABSOLUTELY NO WARRANTY. ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. ;;; (use scmail) (use scmail.config) (use scmail.mail) (define (main-process mailbox target-folder dry-run-mode) (let* ((mailbox-type (ref (scmail-config) 'mailbox-type)) (mail (make-scmail-mail mailbox-type :mailbox mailbox :dry-run-mode dry-run-mode))) (scmail-filter mail) (unless (scmail-mail-removed? mail) (refile mail (slot-ref (scmail-config) 'inbox))))) (define (main args) (with-error-handler (lambda (e) 75) (lambda () (scmail-main args main-process 'deliver-rules #t) 0))) scmail-1.3.orig/scbayes.in0000644000175000017500000004646010061102402016255 0ustar gniibegniibe00000000000000#! @GOSH@ ;;; ;;; scbayes - simple front-end of scmail/bayesian-filter ;;; ;;; Copyright(C) 2003 by Shiro Kawai (shiro@acm.org) ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. ;;; (use gauche.parseopt) (use gauche.parameter) (use dbm) (use dbm.gdbm) ;; should be customizable (use util.digest) (use srfi-13) (use srfi-19) (use rfc.md5) (use file.util) (use scmail.bayesian-filter) (use scmail) (use scmail.mail) (use scmail.mailbox) (use scmail.config) (use scmail.progress) (use scmail.util) ;; NB: this script is just for an experiment of bayesian filtering, and ;; not intended to be a robust tool for day-to-day use, although it's quite ;; possible that this will eventually evolve to such a tool. ;; Usage: ;; scbayes --learn-nonspam folder ;; scbayes --learn-spam folder ;; scbayes --check-mail path ;; scbayes --check-folder folder (define command (lambda () (usage))) (define *table-file* #f) (define (table-file) (or *table-file* (scmail-config-get-path 'token-table))) (define (check-folder-path mailbox folder) (unless (or (and (absolute-path? folder) (file-is-directory? folder)) (file-is-directory? (scmail-mailbox-folder->path mailbox folder))) (scmail-eformat "no such folder: ~a" folder))) (define (usage) (print #`"Usage: ,(sys-basename *program-name*) [options] command") (print " Mandatory commands (exclusive):") (print " To build a table: ") (print " * A directory in absolute path can be specified instead of a folder.") (print " --learn-nonspam folder... Learn mails in the folder(s) as non-spams") (print " --learn-spam folder... Learn mails in the folder(s) as spams") (print " --unlearn-nonspam folder... Unlearn mails in the folder(s) as non-spams") (print " --unlearn-spam folder... Unlearn mails in the folder(s) as spams") (print " To test:") (print " --check-mail path Show spamness of the mail") (print " --check-spam folder Check spamness of mails in the folder") (print " --check-nonspam folder Check spamness of mails in the folder") (print " --table-stat Prints # of entries in the table") (print " --dump-table Dump entries in the table") (print " --dump-digest Dump entries in the digest DB") (print " Options") (print " --force Don't skip mails already digest") (print " --slow Learn slowly with periodic sleep") (print " --flush-interval num Specify interval of flushing [unlimited]") (print " --table file Specify alternative DB file") (print " --digest file Specify alternative digest DB file") (print " -c, --config file Specify alternative config file") (print " -d, --scmail-dir dir Specify scmail's directory") (print " -v, --verbose Work noisily (diagnostic output)") (print " -q, --quiet Suppress all normal output") (print " -h, --help Display this help and exit") (exit 0)) (define (temporary-table-file) (string-append (table-file) ".tmp")) (define (lock-file) (string-append (table-file) ",lock")) (define (prepare-temporary-files) (define (copy progress src dest) (call-with-output-file dest (lambda (oport) (call-with-input-file src (lambda (iport) (let loop ((block (read-block 8192 iport)) (i 1)) (unless (eof-object? block) (begin (progress-inc! progress (string-length block)) (display block oport) (if (and (slow?) (= (modulo i 128) 0)) (sys-sleep 1)) (loop (read-block 8192 iport) (+ i 1)))))))))) (when (and (not (file-exists? (table-file))) (file-exists? (digest-file))) (scmail-wformat "~a is found while ~a is not found." (digest-file) (table-file)) (scmail-eformat "(Please remove ~a if you don't need it.)" (digest-file))) (when (file-exists? (table-file)) (let1 progress (make :title "prepare" :total (+ (file-size (table-file)) (if (file-exists? (digest-file)) (file-size (digest-file)) 0))) (copy progress (table-file) (temporary-table-file)) (if (file-exists? (digest-file)) (copy progress (digest-file) (temporary-digest-file))) (progress-finish! progress)))) (define (swap-files) (with-signal-handlers (((list SIGINT SIGHUP SIGTERM) => #f)) (lambda () (sys-rename (temporary-table-file) (table-file)) (sys-rename (temporary-digest-file) (digest-file))))) (define (lock) (unless (eq? (create-directory* (lock-file)) #t) (scmail-wformat "~a is now being updated" (table-file)) (scmail-wformat "or perhaps ~a is staled." (lock-file)) (scmail-eformat "(Please remove the lock file if it is staled.)")) ) (define force-learn? (make-parameter #f)) (define slow? (make-parameter #f)) (define *digest-file* #f) (define (digest-file) (or *digest-file* (scmail-config-get-path 'digest))) (define digest-db (make-parameter #f)) (define digest-cache (make-parameter (make-hash-table 'string=?))) (define (temporary-digest-file) (string-append (digest-file) ".tmp")) (define (add-to-digest-db! key value) (dbm-put! (digest-db) key value)) (define (delete-from-digest-db! key value) (dbm-delete! (digest-db) key)) (define (learned? digest) (if (or (hash-table-exists? (digest-cache) digest) (and (digest-db) (dbm-exists? (digest-db) digest))) #t #f)) (define (not-learned? digest) (not (learned? digest))) (define (mail-digest mail) (let1 md5 (make ) (for-each (lambda (name) (digest-update! md5 (scmail-mail-query mail name))) '(date from message-id subject)) (digest-hexify (digest-final! md5)))) (define (add-to-digest-cache! digest) (hash-table-put! (digest-cache) digest (number->string (sys-time)))) (define-constant *dbm-class* ) ;; should be customizable (define (open-digest-db file) (with-error-handler (lambda (e) (scmail-eformat "~a" (ref e 'message))) (lambda () (digest-db (dbm-open *dbm-class* :path file :rw-mode :write))))) (define (collect-target-files mailbox folder) (if (and (absolute-path? folder) (file-is-directory? folder)) (directory-list folder :children? #t :add-path? #t :filter (lambda (x) (file-is-regular? (build-path folder x)))) (scmail-mailbox-mail-list mailbox folder))) (define (collect-target-files-from-folders mailbox folders) (apply append (map (lambda (folder) (collect-target-files mailbox folder)) folders))) (define flush-interval (make-parameter 0)) ;; unlimited (define (learn-common table-type folders task-name skip? process-words update-digest-db!) (define (flush-token-table-cache progress) (token-table-cache-flush (lambda (i) (progress-inc! progress) (if (and (slow?) (= (modulo i 100) 0)) (sys-sleep 1)) ))) (define (flush-digest-cache progress) (let1 counter 1 (hash-table-for-each (digest-cache) (lambda (key value) (update-digest-db! key value) (progress-inc! progress) (if (and (slow?) (= (modulo counter 100) 0)) (sys-sleep 1)) (inc! counter))) (digest-cache (make-hash-table 'string=?)))) (define (flush-both-cache) (let1 total (+ (length (hash-table-keys (digest-cache))) (token-table-cache-length)) (if (> total 0) (let1 progress (make :title "flush" :total total :bar-mark #\.) (flush-token-table-cache progress) (flush-digest-cache progress) (progress-finish! progress))))) (define (learn-files files) (let ((learned-file-count 0) (progress (make :title task-name :total (length files)))) (for-each (lambda (file) (let* ((mail (make :file file)) (digest (mail-digest mail))) (if (or (force-learn?) (not (skip? digest))) (with-error-handler (lambda (e) (scmail-wformat "~a: ~a" file (ref e 'message))) (lambda () (process-words mail table-type) (add-to-digest-cache! digest) (inc! learned-file-count) (if (slow?) (sys-sleep 1)) (when (and (> (flush-interval) 0) (= (modulo learned-file-count (flush-interval)) 0)) (newline) (flush-both-cache)) (scmail-dformat "~a: ~a: ~a" learned-file-count task-name file) )) (scmail-dformat "skip: ~a" file)) (progress-inc! progress))) files) (progress-finish! progress) learned-file-count)) ;; FIXME: copied from progress.scm (define (time-difference->real time0 time1) (let1 time (time-difference time0 time1) (+ (time-second time) (/ (time-nanosecond time) 1000000000)))) (define (.xx number) (/ (round (* number 100)) 100)) (define (report start-time learned-file-count) (let1 elapsed (time-difference->real (current-time) start-time) (format #t "summary: ~:d ~a mails ~a ~aed in ~:d sec. (~a mails/sec.)\n" learned-file-count (if (eq? table-type token-table-index-of-spam) "spam" "nonspam") (if (<= learned-file-count 1) "is" "are") task-name (.xx elapsed) (if (> elapsed 0) (.xx (/ learned-file-count elapsed)) "NaN") ))) (define (cleanup) (if (file-exists? (temporary-table-file)) (sys-unlink (temporary-table-file))) (if (file-exists? (temporary-digest-file)) (sys-unlink (temporary-digest-file))) (sys-rmdir (lock-file))) (let1 mailbox (make-scmail-mailbox (ref (scmail-config) 'mailbox-type) (ref (scmail-config) 'mailbox)) (scmail-config-make-directory) (for-each (lambda (folder) (check-folder-path mailbox folder)) folders) (lock) (let ((learned-file-count 0) (start-time (current-time))) (dynamic-wind (lambda () #t) (lambda () (prepare-temporary-files) (open-digest-db (temporary-digest-file)) (with-token-table (temporary-table-file) :write (lambda () (let ((target-files (collect-target-files-from-folders mailbox folders))) (set! learned-file-count (learn-files target-files)) (flush-both-cache) ))) (swap-files) (report start-time learned-file-count) ) (lambda () (cleanup) ))))) (define (learn table-type folders) (learn-common table-type folders "learn" learned? token-table-collect-words add-to-digest-db!)) (define (unlearn table-type folders) (learn-common table-type folders "unlearn" not-learned? token-table-discard-words delete-from-digest-db!)) (define (check-spamness-of-mail file) (unless (file-is-readable? file) (scmail-eformat "can't read ~a" file)) (with-token-table (table-file) :read (lambda () (receive (prob lang words) (spamness-of-mail (make :file file)) (print file) (print #`" ,prob") (for-each (lambda (w) (print #`" ,(car w) : ,(cdr w)")) words) prob))) 0) ;; (test-spamness-of-files nonspam-files #f) ;; (test-spamness-of-files spam-files #t) (define (test-spamness-of-files files expect-spam?) (let ((threshold 0.9) (count 0) (bad '()) (mailbox-type (ref (scmail-config) 'mailbox-type))) (for-each (lambda (file) (let1 mail (make-scmail-mail mailbox-type :file file) (inc! count) (receive (prob lang words) (spamness-of-mail mail) (when (or (and expect-spam? (< prob threshold)) (and (not expect-spam?) (>= prob threshold))) (push! bad (list file prob words)) )))) files) (print #`"Out of ,count messages") (print #`" ,(length bad) messages are identified incorrectly:") (for-each (lambda (entry) (print #`" ,(sys-basename (car entry)) (score=,(cadr entry)):") (for-each (lambda (w) (print #`" ,(car w) : ,(cdr w)")) (caddr entry))) bad) (length bad) )) (define (check-spamness-in-folder folder spam?) (let ((number-of-incorrect-answers 0) (mailbox (make-scmail-mailbox (ref (scmail-config) 'mailbox-type) (ref (scmail-config) 'mailbox)))) (check-folder-path mailbox folder) (with-token-table (table-file) :read (lambda () (set! number-of-incorrect-answers (test-spamness-of-files (collect-target-files mailbox folder) spam?)))) number-of-incorrect-answers)) (define (table-stat) (with-token-table (table-file) :read (lambda () (let ((mcount (token-table-message-count)) (tcount (token-table-token-count)) (totals (make-list (token-table-number-of-values) 0))) (format #t "lang nonspam spam\n") (dolist (lang (token-table-languages)) (let1 v (list (ref tcount (token-table-index-of-nonspam lang)) (ref mcount (token-table-index-of-nonspam lang)) (ref tcount (token-table-index-of-spam lang)) (ref mcount (token-table-index-of-spam lang))) (apply format #t "~4a: ~7dw/~5dm ~7dw/~5dm\n" lang v) (set! totals (map + totals v)))) (apply format #t "total:~7dw/~5dm ~7dw/~5dm\n" totals)))) 0) (define (dump-table) (with-token-table (table-file) :read (lambda () (token-table-for-each (lambda (key value) (unless (string-prefix? (token-table-special-key-prefix) key) (format #t "~a\t~a\n" key value)))))) 0) (define (dump-digest) (open-digest-db (digest-file)) (dbm-for-each (digest-db) (lambda (key value) (format #t "~a\t~a\n" key value))) 0) ;;(define (update-db old-db) ;; (format #t #`"converting ,old-db to ,(table-file)...") ;; (flush) ;; (convert-database old-db (table-file)) ;; (print "done.") ;; 0) (define (main args) (define folders '()) (define (get-folders) (if (null? folders) (scmail-eformat "one or more folders should be specified")) folders) (define (learn-internal table) (learn table (get-folders)) 0) (define (unlearn-internal table) (unlearn table (get-folders)) 0) (scmail-set-program-name! (car args)) (scmail-check-gauche-version) (let* ((config-file (scmail-config-default-file)) (verbose-mode? #f) (quiet-mode? #f) (rest (parse-options (cdr args) (("learn-nonspam" () (set! command (lambda () (learn-internal token-table-index-of-nonspam)))) ("learn-spam" () (set! command (lambda () (learn-internal token-table-index-of-spam)))) ("unlearn-nonspam" () (set! command (lambda () (unlearn-internal token-table-index-of-nonspam)))) ("unlearn-spam" () (set! command (lambda () (unlearn-internal token-table-index-of-spam)))) ("check-mail=s" (file) (set! command (lambda () (check-spamness-of-mail file)))) ("d|scmail-dir=s" (dir) (scmail-config-set-directory! dir)) ("check-nonspam=s" (folder) (set! command (lambda () (check-spamness-in-folder folder #f)))) ("check-spam=s" (folder) (set! command (lambda () (check-spamness-in-folder folder #t)))) ("dump-table" () (set! command (lambda () (dump-table)))) ("dump-digest" () (set! command (lambda () (dump-digest)))) ("table-stat" () (set! command (lambda () (table-stat)))) ;;("update-db=s" (old-db) ;; (set! command (lambda () (update-db old-db)))) ("c|config=s" (file) (set! config-file file)) ("table=s" (table) (set! *table-file* (expand-path table))) ("digest=s" (file) (set! *digest-file* (expand-path file))) ("force" () (force-learn? #t)) ("slow" () (slow? #t)) ("flush-interval=i" (i) (flush-interval i)) ("v|verbose" () (set! verbose-mode? #t)) ("q|quiet" () (set! quiet-mode? #t)) ("h|help" () (usage)) (else _ (usage)))))) (if verbose-mode? (scmail-config-set-verbose-mode!)) (set! folders rest) (with-output-to-port (if quiet-mode? (open-output-file "/dev/null") (standard-output-port)) (lambda () (scmail-config-read config-file) (command))) )) ;; Local variables: ;; mode: scheme ;; end: scmail-1.3.orig/scmail.scm0000644000175000017500000003405110101214210016235 0ustar gniibegniibe00000000000000;;; ;;; scmail - a mail filter written in Scheme ;;; ;;; Copyright (C) 2002-2004 Satoru Takabayashi ;;; All rights reserved. ;;; This is free software with ABSOLUTELY NO WARRANTY. ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, ;;; provided that existing copyright notices are retained in all ;;; copies and that this notice is included verbatim in all ;;; distributions. ;;; This software is provided as is, without express or implied ;;; warranty. In no circumstances the author(s) shall be liable ;;; for any damages arising out of the use of this software. ;;; (define-module scmail (use srfi-1) (use srfi-13) (use srfi-19) (use gauche.regexp) (use gauche.parseopt) (use gauche.parameter) (use file.util) (use scmail.config) (use scmail.util) (use scmail.mail) (use scmail.mailbox) (use scmail.mh) (use scmail.maildir) (export scmail-filter scmail-main scmail-command-log scmail-error-log scmail-log add-filter-rule! add-bayesian-filter-rule! valid-rule? copy refile forward redirect remove set-match-data-replace-rule! ;; for backward compatibility command-copy command-refile command-forward )) (select-module scmail) (autoload scmail.bayesian-filter mail-is-spam?) (define (scmail-log-to-file prefix fmt . args) (with-error-handler (lambda (e) '()) (lambda () (call-with-output-file (scmail-config-get-path 'log-file) (lambda (port) (apply format port (string-append prefix fmt) args)) :if-exists :append)))) (define (scmail-log fmt . args) (let* ((tz-offset (date-zone-offset (time-utc->date (current-time)))) (fmt (if (safe-rxmatch #/\n$/ fmt) fmt (string-append fmt "\n"))) (prefix (format "~a~a~2,'0d:~2,'0d " (sys-strftime "%Y-%m-%dT%H:%M:%S" (sys-localtime (sys-time))) (if (< tz-offset 0) "-" "+") (round (/ tz-offset 3600)) (round (/ (modulo tz-offset 3600) 60))))) (apply format #t fmt args) (apply scmail-log-to-file prefix fmt args))) (define (scmail-command-log command src . dest) (let* ((dest (get-optional dest #f)) (message (if dest (format "~a: ~a -> ~a" command src dest) (format "~a: ~a" command src) ))) (scmail-log "~a" message))) (define (scmail-error-log fmt . args) (apply scmail-log (string-append "error: " fmt) args)) (define (cut-mailbox-part file mailbox) (let ((m (safe-rxmatch #`"^,|mailbox|/+" file))) (if m (rxmatch-after m) file))) ;; basic mail operation (define-method copy ((mail ) folder) (let1 folder (replace-param folder) (let* ((file (scmail-mail-query mail 'file)) (mailbox (ref (scmail-config) 'mailbox)) (src (cut-mailbox-part file mailbox))) (let* ((out-file (scmail-mail-copy mail folder)) (dest (cut-mailbox-part out-file mailbox))) (scmail-command-log 'copy src dest))) :next)) ;; basic mail operation (define-method refile ((mail ) folder) (define (refile-internal mail folder) (if (scmail-mail-from-stdin? mail) (let1 new-name (scmail-mail-copy mail folder) (scmail-mail-remove mail) new-name) (with-error-handler (lambda (e) (scmail-error-log "refile: ~a" (ref e 'message)) (scmail-mail-copy mail folder) (scmail-mail-remove mail)) (lambda () (scmail-mail-move mail folder) )))) (let1 folder (replace-param folder) (let* ((file (scmail-mail-query mail 'file)) (mailbox (ref (scmail-config) 'mailbox)) (src (cut-mailbox-part file mailbox))) (let* ((out-file (refile-internal mail folder)) (dest (cut-mailbox-part out-file mailbox))) (scmail-command-log 'refile src dest))) :last)) (define-method forward-internal ((mail ) address command) (let1 folder (replace-param address) (let* ((file (scmail-mail-query mail 'file)) (mailbox (ref (scmail-config) 'mailbox)) (src (cut-mailbox-part file mailbox))) (scmail-mail-forward mail (ref (scmail-config) 'smtp-host) address) (if (eq? command 'redirect) (scmail-mail-remove mail)) (scmail-command-log command src address)))) ;; basic mail operation (define-method forward ((mail ) address) (forward-internal mail address 'forward) :next) ;; basic mail operation (define-method redirect ((mail ) address) (forward-internal mail address 'redirect) :last) ;; basic mail operation (define-method remove ((mail )) (let* ((file (scmail-mail-query mail 'file)) (mailbox (ref (scmail-config) 'mailbox)) (src (cut-mailbox-part file mailbox))) (scmail-mail-remove mail) (scmail-command-log 'remove src) :last)) ;; backward compatibility (define (command-copy config mail folder) (copy mail folder)) (define (command-refile config mail folder) (refile mail folder)) (define (command-forward config mail folder) (forward mail folder)) ;; (set-match-data-replace-rule! #/\./ "-") (define match-data-replace-rule (make-parameter #f)) (define (set-match-data-replace-rule! rule) (match-data-replace-rule rule)) (define last-match-data (make-parameter #f)) (define (replace-param param) (if (last-match-data) (regexp-replace-all #/\\([\d+])/ param (lambda (m) (let ((str (rxmatch-substring (last-match-data) (string->number (rxmatch-substring m 1))))) (if (match-data-replace-rule) (let* ((pattern (car (match-data-replace-rule))) (replacement (cadr (match-data-replace-rule)))) (regexp-replace-all pattern str replacement)) str)))) param)) (define (process-command mail command param) (cond ((eq? command 'refile) (refile mail param)) ((eq? command 'copy) (copy mail param)) ((eq? command 'forward) (forward mail param)) ((eq? command 'redirect) (redirect mail param)) ((eq? command 'remove) (remove mail)))) (define (match-rule? mail field-name pattern) (last-match-data #f) (if (regexp? pattern) (find (lambda (field-value) (last-match-data (safe-rxmatch pattern field-value)) (last-match-data)) (scmail-mail-query mail field-name :multi-field)) (find (lambda (field-value) (string-contains field-value pattern)) (scmail-mail-query mail field-name :multi-field)))) (define (process-rule mail field-name patterns command param) (if (null? patterns) :next (let* ((pattern (car patterns)) (status (if (match-rule? mail field-name pattern) (process-command mail command param) :next))) (if (eq? status :next) (process-rule mail field-name (cdr patterns) command param) :last)))) (define (apply-rule mail rule) (let ((field-name (car rule)) (field-rules (cdr rule))) (let loop ((field-rules field-rules)) (if (null? field-rules) :next (let* ((pattern-and-command (car field-rules)) (patterns (if (list? (first pattern-and-command)) (first pattern-and-command) (list (first pattern-and-command)))) (command (if (list? (second pattern-and-command)) (first (second pattern-and-command)) 'refile)) (param (if (list? (second pattern-and-command)) (if (= (length (second pattern-and-command)) 1) #f ;; for "remove" (second (second pattern-and-command))) (second pattern-and-command)))) (let ((status (process-rule mail field-name patterns command param))) (if (eq? status :last) :last (loop (cdr field-rules))))))))) (define-method object-apply ((mail ) field-name pattern) (match-rule? mail field-name pattern)) ;; Filter a mail (define (scmail-filter mail) (define (scmail-filter-iter mail filter-rules) (unless (null? filter-rules) (let* ((rule (car filter-rules)) (status (with-error-handler (lambda (e) (scmail-error-log "in a rule: ~a" (ref e 'message)) :next) (lambda () (cond ((procedure? rule) (if (= (arity rule) 2) ; backward compatibility (rule (scmail-config) mail) (rule mail))) (else (apply-rule mail rule))))))) (unless (eq? status :last) (scmail-filter-iter mail (cdr filter-rules)))))) (unless (is-a? mail ) (scmail-eprintf " required but got ~a" (class-of mail))) (scmail-filter-iter mail (filter-rules))) (define filter-rules (make-parameter '())) (define (valid-rule? rule) (define (valid-pattern-part? pattern-part) (or (string? pattern-part) (regexp? pattern-part) (and (list? pattern-part) (every (lambda (pattern) (or (string? pattern) (regexp? pattern))) pattern-part)))) (define (valid-destination-part? destination-part) (or (string? destination-part) (and (list? destination-part) (or (and (= (length destination-part) 1) (symbol? (first destination-part))) (and (= (length destination-part) 2) (symbol? (first destination-part)) (string? (second destination-part))))))) (define (set-of-rules? field-rules) (if (null? field-rules) #t (let1 field-rule (car field-rules) (if (and (list? field-rule) (= (length field-rule) 2) (valid-pattern-part? (first field-rule)) (valid-destination-part? (second field-rule))) (set-of-rules? (cdr field-rules)) #f)))) (if (or (and (procedure? rule) (or (= (arity rule) 1) (= (arity rule) 2))) (and (list? rule) (symbol? (car rule)) (list? (cdr rule)) (set-of-rules? (cdr rule)))) #t #f)) (define (add-filter-rule! . rules) (for-each (lambda (rule) (if (valid-rule? rule) (filter-rules (append (filter-rules) (list rule))) (scmail-error-log "invalid rule: ~s" rule) )) rules)) (define (bayesian-filter mail) (and (mail-is-spam? mail) (refile mail (ref (scmail-config) 'spam)))) (define (add-bayesian-filter-rule!) (add-filter-rule! bayesian-filter)) (define (read-filter-rule file) (with-error-handler (lambda (e) (scmail-error-log (ref e 'message)) '()) (lambda () (call-with-input-file file (lambda (port) (load-from-port port))) (filter-rules)))) (define (show-help program-name) (format (current-output-port) "Usage: ~a\n" (sys-basename program-name)) (print " -c, --config=FILE use FILE as a config file") (print " -r, --rule=FILE use FILE as a rule file") (print " -f, --folder=FOLDER refile mails in FOLDER") (print " -d, --scmail-dir=DIR set scmail's directory to DIR") (print " -n, --dry-run don't actually run; just print them") (print " (disables copy/refile/forward/redirect/remove)") (print " -v, --verbose work noisily (diagnostic output)") (print " -q, --quiet suppress all normal output") (print " -h, --help display this help and exit") (exit 0)) (define (scmail-main args main-process rule quiet-mode) (scmail-set-program-name! (car args)) (scmail-check-gauche-version) (let* ((config-file (scmail-config-default-file)) (rule-file (scmail-config-get-path rule)) (target-folder #f) (verbose-mode #f) (dry-run-mode #f)) (parse-options (cdr args) (("h|help" () (show-help (car args))) ("c|config=s" (file) (set! config-file file)) ("d|scmail-dir=s" (dir) (scmail-config-set-directory! dir)) ("n|dry-run" () (set! create-directory* values) (set! scmail-log-to-file values) (set! dry-run-mode #t)) ("r|rule=s" (file) (set! rule-file file)) ("v|verbose" () (set! verbose-mode #t)) ("q|quiet" () (set! quiet-mode #t)) ("f|folder=s" (folder) (set! target-folder folder)))) (if verbose-mode (scmail-config-set-verbose-mode!)) (with-output-to-port (if quiet-mode (open-output-file "/dev/null") (standard-output-port)) (lambda () (scmail-config-read config-file) (sys-umask (ref (scmail-config) 'umask)) (scmail-config-make-directory) (read-filter-rule rule-file) (main-process (make-scmail-mailbox (ref (scmail-config) 'mailbox-type) (ref (scmail-config) 'mailbox)) (or target-folder (ref (scmail-config) 'inbox)) dry-run-mode )) )) ) (provide "scmail") scmail-1.3.orig/codeconv.scm0000644000175000017500000000026510061102401016570 0ustar gniibegniibe00000000000000(use gauche.charconv) (define (main args) (call-with-input-file (cadr args) (lambda (in) (copy-port in (current-output-port) :unit 'char)) :encoding "euc-jp") 0) scmail-1.3.orig/check-gauche.scm0000644000175000017500000000007110061102401017272 0ustar gniibegniibe00000000000000(use scmail.util) (scmail-check-gauche-version) (exit 0)