diff options
| author | fukachan <fukachan> | 2002-12-10 12:04:52 +0000 |
|---|---|---|
| committer | fukachan <fukachan> | 2002-12-10 12:04:52 +0000 |
| commit | 4d22e01c81b228d4103d0407513e02cb2d155663 (patch) | |
| tree | 7d02bb73a4a04ae781a7b717fb36606695592a32 | |
| parent | 451f5fc29a94e13ec13c99d90ab9c748171fb829 (diff) | |
| download | fml8-im-142.tar.gz fml8-im-142.tar.bz2 fml8-im-142.zip | |
im-142im-142
91 files changed, 6628 insertions, 3446 deletions
diff --git a/img/dist/IM/00changes b/img/dist/IM/00changes index 8745939a..77620975 100644 --- a/img/dist/IM/00changes +++ b/img/dist/IM/00changes @@ -1,3 +1,89 @@ +142 (2002/12/07) + +* New maintainer, Tatsuya Kinoshita <tats@vega.ocn.ne.jp>. I obtained + previous maintainer's consent. I disclaim my copyright for this work. +* 00readme: Revised. +* Revise documents. Manuals in nroff source form can be generated by pod2man. +* Revise help messages. +* OS2/00readme: Add comment that OS2 support is outdated. +* Coding style fix. +* imput.in (trash_message): Fix im_notice string. +* Makefile.in (CNF): New variable. +* configure.in, configure: Set mode to 755 instead of 555 for excutables. +* imsetup.in, cnf.im/SiteConfig.in, dot.im/Config: Modify comments for + FsyncNumber. +* IM/Config.pm.in ($FsyncNumber): New variable. +* configure.in, configure: New option, `--with-fsyncno'. +* configure.in, configure: New option, `--with-hostname'. +* IM/LocalMbox.pm (process_file): Bug fix for getchk_sub. +* IM/Alias.pm, IM/Scan.pm: Regexp fix. +* IM/Config.pm.in, IM/EncDec.pm: Prevent a warning of `called too early to + check prototype'. +* IM/MsgStore.pm (new_message): Use message_number() instead of $MsgNum++. +* install-sh: Bug fix from GNU libtool 1.4.3. This file is under M.I.T. + license. +* imhsync.in, immknmz.in, IM/Ssh.pm: Clarify copyright notice. +* imcat.in: `-S' option for SSHServer. + +141+tats20021028 (2002/10/28) unofficial release + +* impwagent.in, immknmz.in: Local security fix. +* imsetup.in, cnf.im/SiteConfig.in, dot.im/Config: Modify comments for + `NamazuV2', `NamazuLockDir', and `PwAgentTmpDir'. +* impwagent.in, IM/GetPass.pm: Use pwagent_tmp_path(). +* impwagent.in: mkdir race condition fix. +* IM/Config.pm.in (pwagent_tmp_dir, pwagent_tmp_path): New subroutines. +* IM/Config.pm.in (@CfgConfig): Set `PwAgentTmpDir' to `pwagtmp' + (relative to ~/.im/). +* immknmz.in: Use namazu_lock_path(). +* immknmz.in: Generate unique name for temporary file. +* IM/Config.pm.in (namazu_lock_dir, namazu_lock_path): New subroutines. +* IM/Config.pm.in (@CfgConfig): Set `NamazuLockDir' to `nmzlock' + (relative to ~/.im/). + +141+tats20021001 (2002/10/01) unofficial release + +* imsetup.in (read_conf): Fix garbled $mail/$news problem for Perl 5.8.0. + +141+tats20020413 (2002/04/13) unofficial release + +* imsetup.in: Use site configuration for UseCL and NoSync. +* IM/Config.pm.in (use_cl): New function. + +141+tats20020127 (2002/01/27) unofficial release + +* imsetup.in: `MBoxStyle=qmail' support. + (Thanks to Kazuhiro NISHIYAMA, [img 00564]) +* imsetup.in, cnf.im/SiteConfig.in, dot.im/Config: + Replace `/MailDir#' with `/Maildir #'. + Add comments for sharing Addrbook with Mew 2. +* Makefile.in: Avoid `[ ... ] || ( ... )' for portability. + (Thanks to SAKAI Kiyotaka, [img 00528]) +* IM/Scan.pm (substr_safe): Non-ascii G0 fix for gb2312-1980. + +141+tats20020108 (2002/01/08) unofficial release + +* IM/Scan.pm: Big5 support. + (Thanks to Issei Numata, [img 00562], [mew-dist 19969]) + +141+tats20011114 (2001/11/14) unofficial release + +* IM/TcpTransaction.pm (pool_priv_sock): Add no strict 'subs' + for AF_INET6. (Thanks to ISHIKAWA Mutsumi) + +141+tats20011108 (2001/11/08) unofficial release + +* IM/TcpTransaction.pm: Apply a patch for IPv6. + IPv6 and IPv4 are supported when the Socket6 module + (http://www.cpan.org/modules/by-module/Socket6/) is installed. + (Thanks to Hajimu UMEMOTO, [Mew-dist 12680]) +* IM/MD5.pm: Fix 64bit integer problem. + (Thanks to Yasuhisa Itoh, [Mew-dist 15884], [Mew-dist 17097]) +* imsetup.in: Add support for `User='. ([Mew-dist 17097]) +* IM/Pop.pm: Allow multiple spaces. ([mew-dist 17988]) +* immknmz.in: Fix race condition problem for local security. + (Thanks to Koga Youichirou, [mew-dist 18577]) + 141 (2000/04/14) mew-dist release * IMAP password hack. @@ -11,7 +97,7 @@ * ISO-2022-JP-3 Hideyuki SHIRAI <shirai@rdmg.mgcs.mei.co.jp> -140 (2000/02/28) mew-release release +140 (2000/02/28) mew-release releas * Patches for namazu. Hideyuki SHIRAI <shirai@rdmg.mgcs.mei.co.jp> diff --git a/img/dist/IM/00readme b/img/dist/IM/00readme index f5052e25..2b41fd95 100644 --- a/img/dist/IM/00readme +++ b/img/dist/IM/00readme @@ -3,20 +3,29 @@ Kazu Yamamoto Sep 5, 1999 + Modified by Tatsuya Kinoshita on Dec 7, 2002 + + <<<Copyright>>> This package provides a series of user interface commands (im* -commands) and backend Perl5 libraries to integrate Email and NetNews -handling. They are designed to be used both from Mew and on command -line. +commands) and backend Perl5 modules to integrate E-mail and NetNews +handling. They are designed to be used both from Mew version 1.x and +on command line. -The folder style of Mew is exactly the same as that of MH. So, you can +The folder style of IM is exactly the same as that of MH. So, you can replace MH with this package without any migration works. Moreover, you are able to operate your messages both by IM and MH with consistent manner. -All programs/libraries conforms the BSD like "AS IS" copyright. This -means, in short words, free but no warranty. +IM is free software; you can redistribute it and/or modify it under +the modified BSD license. See 00copyright for more details. + +IM/MD5.pm is derived from md5.pl copyrighted by NAKAMURA, Motonori +<motonori@econ.kyoto-u.ac.jp>. It is converted to Perl4 from C version +derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm. + +install-sh is under the M.I.T. license. <<<Installing under the root privilege>>> @@ -83,7 +92,11 @@ have the root privilege. <<<Contributions and Bug Reports>>> -Please send comments, bug reports, and patches to "img@mew.org". +Please send comments, bug reports, and patches to <img@mew.org>. +You can contact the current maintainer (Tatsuya Kinoshita, since +October 2002) by this e-mail address. + +See also "IM Official Site" (http://tats.iris.ne.jp/im/). <<<Programmers>>> diff --git a/img/dist/IM/IM/Address.pm b/img/dist/IM/IM/Address.pm index ba5129cd..089a8b31 100644 --- a/img/dist/IM/IM/Address.pm +++ b/img/dist/IM/IM/Address.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Address.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Address.pm version 20021207(IM142)"; package IM::Address; require 5.003; @@ -22,36 +22,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(extract_addr replace_addr fetch_addr); -=head1 NAME - -Address - RFC822 style address parser - -=head1 SYNOPSIS - - use IM::Address; - - $pure_address_portion = &extract_addr($address_with_comment); - - $replaced_address = &replace_addr($original_address_with_comment, - $pure_notation_of_old_address, $pure_notation_of_new_address); - - ($first, $rest) = &fetch_addr($address_list, $pure_address_flag); - -=head1 DESCRIPTION - - $a = "Motonori Nakamura <motonori\@econ.kyoto-u.ac.jp>"; - &extract_addr($a) returns "motonori@econ.kyoto-u.ac.jp". - - $a = "Motonori Nakamura <motonori\@econ.kyoto-u.ac.jp>"; - $b = "motonori\@econ.kyoto-u.ac.jp"; - $c = "motonori\@wide.ad.jp"; - &replace_addr($a, $b, $c) returns "Motonori Nakamura <motonori@wide.ad.jp>". - - $a = "kazu, nom, motonori"; - &fetch_addr($a, 0) returns ("kazu", " nom, motonori"). - -=cut - use vars qw($FOR_SMTP); # sub fetch_addr ##### EXTRACT AN ADDRESS FROM AN ADDRESS EXPRESSION ##### @@ -60,7 +30,7 @@ use vars qw($FOR_SMTP); # sub fetch_addr # address: an address in any style # return values: pure address portion (NULL if error) # -sub extract_addr ($) { +sub extract_addr($) { my $addrin = shift; $addrin =~ s/\n\s+//g; @@ -75,8 +45,8 @@ sub extract_addr ($) { # new: # return value: replaced expression # -sub replace_addr ($$$) { - my ($expr, $old, $new) = @_; +sub replace_addr($$$) { + my($expr, $old, $new) = @_; my $qold = quotemeta($old); if ($expr =~ /$qold.*$qold/) { @@ -99,18 +69,18 @@ sub replace_addr ($$$) { # rest: rest of address in the list # friendly: user friendly portion of the first address # -sub fetch_addr ($$) { - my ($addrin, $extract) = @_; - my ($addrout, $pureout, $groupsyntax) = ('', '', ''); - my ($friendly1, $friendly2, $c) = ('', '', ''); - my ($inquote, $incomment, $addrquote) = (0, 0, 0); - my ($gotpure, $groupcolon, $route) = (0, 0, 0); +sub fetch_addr($$) { + my($addrin, $extract) = @_; + my($addrout, $pureout, $groupsyntax) = ('', '', ''); + my($friendly1, $friendly2, $c) = ('', '', ''); + my($inquote, $incomment, $addrquote) = (0, 0, 0); + my($gotpure, $groupcolon, $route) = (0, 0, 0); im_debug("fetch_addr(in): $addrin\n") if (&debug('addr')); $FOR_SMTP = (&progname =~ /imput/i) unless (defined($FOR_SMTP)); $addrin = '' unless (defined($addrin)); $route = 1 if ($addrin =~ /^\@/); while ($addrin ne '') { - if ($addrin =~ /^([^\e"\\()<>:;,]+)(.*)/s) { + if ($addrin =~ /^([^\e"\\()<>:;,]+)(.*)/s) { #" $c = $1; $addrin = $2; } elsif ($addrin =~ /^\e/) { @@ -131,7 +101,7 @@ sub fetch_addr ($$) { last if ($c eq ',' && !$inquote && !$incomment && !$groupcolon && !$route); - $friendly2 .= $c unless($addrquote); + $friendly2 .= $c unless ($addrquote); if ($inquote) { $addrout .= $c; $pureout .= $c unless ($gotpure); @@ -141,7 +111,7 @@ sub fetch_addr ($$) { ($c, $addrin) = unpack('a a*', $addrin); $addrout .= $c; $pureout .= $c unless ($gotpure); - $friendly2 .= $c unless($addrquote); + $friendly2 .= $c unless ($addrquote); } next; } elsif ($incomment) { @@ -154,7 +124,7 @@ sub fetch_addr ($$) { } elsif ($c eq '\\') { ($c, $addrin) = unpack('a a*', $addrin); $friendly1 .= $c; - $friendly2 .= $c unless($addrquote); + $friendly2 .= $c unless ($addrquote); $addrout .= $c unless ($extract); } chop($friendly1) unless ($incomment); @@ -183,17 +153,17 @@ sub fetch_addr ($$) { $addrout .= $c; $pureout .= $c unless ($gotpure); ($c, $addrin) = unpack('a a*', $addrin); - $friendly2 .= $c unless($addrquote); + $friendly2 .= $c unless ($addrquote); } elsif ($c eq ':') { $addrout .= $c; $pureout .= $c unless ($gotpure); - if ($addrin =~ /^([^"\()<>:;,]+)(.*)/s) { + if ($addrin =~ /^([^"\()<>:;,]+)(.*)/s) { #" $c = $1; $addrin = $2; } else { ($c, $addrin) = unpack('a a*', $addrin); } - $friendly2 .= $c unless($addrquote); + $friendly2 .= $c unless ($addrquote); $groupcolon = 1 if ($c ne ':'); } elsif ($c eq ';') { if ($groupcolon) { @@ -234,6 +204,50 @@ sub fetch_addr ($$) { 1; +__END__ + +=head1 NAME + +IM::Address - RFC822 style address parser + +=head1 SYNOPSIS + + use IM::Address; + + $pure_address_portion = &extract_addr($address_with_comment); + + $replaced_address = &replace_addr($original_address_with_comment, + $pure_notation_of_old_address, $pure_notation_of_new_address); + + ($first, $rest) = &fetch_addr($address_list, $pure_address_flag); + +=head1 DESCRIPTION + +The I<IM::Address> module is a parser for RFC822 style address. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + $a = "Motonori Nakamura <motonori\@econ.kyoto-u.ac.jp>"; + &extract_addr($a) returns "motonori@econ.kyoto-u.ac.jp". + + $a = "Motonori Nakamura <motonori\@econ.kyoto-u.ac.jp>"; + $b = "motonori\@econ.kyoto-u.ac.jp"; + $c = "motonori\@wide.ad.jp"; + &replace_addr($a, $b, $c) returns "Motonori Nakamura <motonori@wide.ad.jp>". + + $a = "kazu, nom, motonori"; + &fetch_addr($a, 0) returns ("kazu", " nom, motonori"). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Alias.pm b/img/dist/IM/IM/Alias.pm index 6a67c068..ccd30b77 100644 --- a/img/dist/IM/IM/Alias.pm +++ b/img/dist/IM/IM/Alias.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Alias.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Alias.pm version 20021207(IM142)"; package IM::Alias; require 5.003; @@ -24,38 +24,6 @@ use vars qw(@ISA @EXPORT); @EXPORT = qw(alias_read alias_lookup alias_print hosts_read hosts_completion hosts_lookup hosts_print); -=head1 NAME - -Alias - mail and host alias looking up package - -=head1 SYNOPSIS - - use IM::Alias; - - alias_read(mail_alias_files, addrbook_files); - $result = alias_lookup(user_name); - alias_print(alias); - - hosts_read(hosts_alias_files); - $result = hosts_completion(mail_address); - hosts_print(alias); - -=head1 DESCRIPTION - - alias_read("$HOME/.im/Aliases", "$HOME/.im/Addrbook"); - hosts_read("$HOME/.hostaliases"); - - $result = alias_lookup('u'); - print "$result\n" if ($result); - - $result = hosts_completion('u@h'); - print "$result\n" if ($result); - - alias_print("a") displays mail addresses whose alias is "a". - hosts_print("") displays all host aliases. - -=cut - use vars qw(%MAIL_ALIAS_HASH %MAIL_ALIASES %HOST_ALIASES); ##### READ MAIL ALIAS FILES ##### @@ -64,7 +32,7 @@ use vars qw(%MAIL_ALIAS_HASH %MAIL_ALIASES %HOST_ALIASES); # # return value: none # -sub alias_read (;$$) { +sub alias_read(;$$) { my @olds = split(',', shift || aliases_file()); my @news = split(',', shift || addrbook_file()); my $usenew = 0; @@ -127,7 +95,7 @@ sub alias_read (;$$) { $cont =~ s/^\s*/ /; $line .= $cont; } - my ($name, $val) = split('\s*[:=]\s*', $line, 2); + my($name, $val) = split('\s*[:=]\s*', $line, 2); $MAIL_ALIASES{$name} = $val if $val; } else { #personal info. Skip continuous lines. @@ -149,7 +117,7 @@ sub alias_read (;$$) { # alias: an alias to be looked up # return value: aliased address OR null # -sub alias_lookup ($) { +sub alias_lookup($) { my $alias = shift; return '' if ($alias =~ /[\@%!:]/o); @@ -168,7 +136,7 @@ sub alias_lookup ($) { # alias: an alias to be looked up # return value: none # -sub alias_print (;$) { +sub alias_print(;$) { my $alias = shift; if ($alias) { @@ -190,7 +158,7 @@ sub alias_print (;$) { # # return value: none # -sub hosts_read (;$) { +sub hosts_read(;$) { my @aliases = split(',', shift || '~/.hostaliases'); my $ali; @@ -222,11 +190,11 @@ sub hosts_read (;$) { # cmpl: flag whether complete with get_host_byname() or not; # return value: completed address OR null # -sub hosts_completion ($;$) { - my ($addr, $cmpl) = @_; +sub hosts_completion($;$) { + my($addr, $cmpl) = @_; - if ($addr =~ /^([\w-.]+)@([\w-.]+)$/) { - my ($local, $domain) = ($1, $2); + if ($addr =~ /^([\w.-]+)@([\w.-]+)$/) { + my($local, $domain) = ($1, $2); im_debug("searching $domain by host alias file.\n") if &debug('alias'); my $new = $HOST_ALIASES{$domain}; if ($new) { @@ -236,7 +204,7 @@ sub hosts_completion ($;$) { if ($cmpl) { im_debug("searching $domain with gethostbyname().\n") if (&debug('alias')); - my ($he_name) = gethostbyname($domain); + my($he_name) = gethostbyname($domain); if (length($he_name) > length($domain)) { im_debug("found(gethostbyname): $domain -> $he_name\n") if (&debug('alias')); @@ -253,7 +221,7 @@ sub hosts_completion ($;$) { # alias: an alias to be looked up # return value: aliased hosts OR null # -sub hosts_lookup ($) { +sub hosts_lookup($) { my $alias = shift; my $host = $HOST_ALIASES{$alias}; if ($host) { @@ -269,7 +237,7 @@ sub hosts_lookup ($) { # alias: an alias to be looked up # return value: none # -sub hosts_print (;$) { +sub hosts_print(;$) { my $alias = shift; if ($alias) { @@ -287,6 +255,52 @@ sub hosts_print (;$) { 1; +__END__ + +=head1 NAME + +IM::Alias - mail and host alias looking up package + +=head1 SYNOPSIS + + use IM::Alias; + + alias_read(mail_alias_files, addrbook_files); + $result = alias_lookup(user_name); + alias_print(alias); + + hosts_read(hosts_alias_files); + $result = hosts_completion(mail_address); + hosts_print(alias); + +=head1 DESCRIPTION + +The I<IM::Alias> module handles mail and host aliases. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + alias_read("$HOME/.im/Aliases", "$HOME/.im/Addrbook"); + hosts_read("$HOME/.hostaliases"); + + $result = alias_lookup('u'); + print "$result\n" if ($result); + + $result = hosts_completion('u@h'); + print "$result\n" if ($result); + + alias_print("a") displays mail addresses whose alias is "a". + hosts_print("") displays all host aliases. + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Config.pm.in b/img/dist/IM/IM/Config.pm.in index 56ebbdb3..1fc3b263 100644 --- a/img/dist/IM/IM/Config.pm.in +++ b/img/dist/IM/IM/Config.pm.in @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Config.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Config.pm version 20021207(IM142)"; package IM::Config; require 5.003; @@ -40,8 +40,8 @@ use vars qw(@ISA @EXPORT); mbox_style nntpservers nntphistoryfile nntpauthuser set_nntpauthuser popaccount pophistoryfile imapaccount httpproxy noproxy - usepwagent pwagentport usepwfiles pwfiles - expand_path usetouchfile touchfile namazuv2 + usepwagent pwagentport pwagent_tmp_dir pwagent_tmp_path usepwfiles pwfiles + expand_path usetouchfile touchfile namazuv2 namazu_lock_dir namazu_lock_path pop_timeout imap_timeout nntp_timeout dns_timeout connect_timeout command_timeout rcv_buf_siz db_type file_attr $SSH_PATH); @@ -70,7 +70,7 @@ $IM_DB_TYPE = '@im_db_type@'; $FSYNC_NO = @im_fsync_no@; $SSH_PATH = "@im_path_ssh@"; -sub file_attr () { +sub file_attr() { return @im_file_attr@; } @@ -86,7 +86,7 @@ $HOME_DIR =~ s:\\:/:g; # "\home\user" -> "/home/user" $HOME_DIR =~ s/\/$//; # "/home/" -> "/home" $IM_SYS_DIR = $ENV{'IM_SYS_DIR'} || "$IM_LIBDIR"; -$IM_USER_DIR = expand_home($ENV{'IM_USER_DIR'} || '.im'); +$IM_USER_DIR = &expand_home($ENV{'IM_USER_DIR'} || '.im'); $IM_SYS_PROFILE = "$IM_SYS_DIR/SiteConfig"; $IM_USER_PROFILE = "$IM_USER_DIR/Config"; @@ -107,6 +107,7 @@ BEGIN { 'msgmode;i;;MsgMode' => 'Message file mode when created', 'usecl;b;;UseCL' => 'Use value of Content-Length header for delimitation', 'nosync;b;;NoSync' => 'Do not need fsync(2) on writing file', + 'fsyncnumber;i;;FsyncNumber' => 'System call number of fsync', 'allowcrlf;b;;AllowCRLF' => 'CRLF may be in saved message', 'preservedot;b;;PreserveDot' => 'Not substitute "." with "/"', 'addrbookfile;s;;AddrBookFile' => 'Address book file', @@ -132,6 +133,7 @@ BEGIN { 'noproxy;s;;Noproxy' => 'URL regex not to use Proxy server', 'usepwagent;b;;UsePwAgent' => 'Use password agent', 'pwagentport;i;;PwAgentPort' => 'Port to connect agent with TCP/IP', + 'pwagenttmpdir;s;;PwAgentTmpDir' => 'Temporary directory for impwagent', 'usepwfiles;b;;UsePwFiles' => 'Use password files', 'pwfiles;s;;PwFiles' => 'Password files', 'poptimeout;i;20;PopTimeout' => 'Timeout for POP connection', @@ -144,15 +146,16 @@ BEGIN { 'usetouchfile;b;;UseTouchFile' => 'Use touch file', 'touchfile;s;;TouchFile' => 'Touch file name', 'namazuv2;b;;NamazuV2' => 'Use Namazu Version 2', + 'namazulockdir;s;;NamazuLockDir' => 'Lock directory for immknmz', ); # these vars should be in current package? - my (@vars) = (); - my ($i, $name, $desc, $dflt, $vnam); + my(@vars) = (); + my($i, $name, $desc, $dflt, $vnam); for ($i = 0; $i < $#CfgConfig; $i+=2) { ($name, $desc, $dflt, $vnam) = split(';', $CfgConfig[$i]); if ($vnam) { - push(@vars, '$' . $vnam); + push(@vars, '$' . $vnam); #' } } # print "use vars qw(@vars);\n"; @@ -163,7 +166,7 @@ BEGIN { ## ## -sub read_cfg_selector ($) { +sub read_cfg_selector($) { my $argvref = shift; my $i = 0; my $selector = ''; @@ -180,11 +183,10 @@ sub read_cfg_selector ($) { return $selector; } -sub init_opt ($;$) -{ - my ($optref, $cptref) = @_; - my ($name, $desc, $dflt, $vnam, $optn, $help); - my ($i, $N); +sub init_opt($;$) { + my($optref, $cptref) = @_; + my($name, $desc, $dflt, $vnam, $optn, $help); + my($i, $N); @O_IORD = (); ## option list in order %O_DESC = (); # --help -> s|s@|i|i@|f|f@|F|F@|b|B @@ -228,7 +230,7 @@ sub init_opt ($;$) $i++; $help = $$optref[$i]; $i++; - if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B|d)$/){ + if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B|d)$/) { my $abbr; if ($name =~ ',') { ($name, $abbr) = split(',', $name); @@ -265,7 +267,7 @@ sub init_opt ($;$) $i++; $help = $cptref->[$i]; $i++; - if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B)$/){ + if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B)$/) { $optn = "-$name"; ## no lc() push(@O_IORD, $optn); if ($vnam) { @@ -288,10 +290,10 @@ sub init_opt ($;$) return 1; } -sub read_env ($) { +sub read_env($) { my $envref = shift; - my ($i, $N) = (0, scalar(@$envref)); - my ($name, $desc, $dflt, $var); + my($i, $N) = (0, scalar(@$envref)); + my($name, $desc, $dflt, $var); while ($i < $N) { ($name, $desc, $dflt, $var) = split(';', $envref->[$i]); @@ -304,8 +306,8 @@ sub read_env ($) { } } -sub read_cfg () { - my ($profile, @profiles); +sub read_cfg() { + my($profile, @profiles); my $prev_line = ''; my $case; my $use; @@ -400,10 +402,10 @@ sub read_cfg () { } } -sub read_opt ($) { +sub read_opt($) { my $argref = shift; - my ($ref, $i, $N) = (0, 0, scalar(@$argref)); - my ($name, $val, $desc, $vnam); + my($ref, $i, $N) = (0, 0, scalar(@$argref)); + my($name, $val, $desc, $vnam); # delete options from @ARGV so that main{} can treat # @ARGV as argments. @@ -468,8 +470,8 @@ sub read_opt ($) { } } -sub set_selector ($;$) { - my ($selector, $base) = @_; +sub set_selector($;$) { + my($selector, $base) = @_; my $s; foreach $s (split(',', $selector)) { ### xxx lc @@ -480,11 +482,11 @@ sub set_selector ($;$) { } else { if (!defined($base) or $base eq 'default') { push(@SELECTORS, $s) if !defined($base); - foreach (keys(%{$s})){ + foreach (keys(%{$s})) { ${$_} = $s->{$_}; } } else { - foreach (keys(%{$s})){ + foreach (keys(%{$s})) { $base->{$_} = $s->{$_}; } } @@ -493,11 +495,11 @@ sub set_selector ($;$) { return 0; } -sub used_selectors () { +sub used_selectors() { return join(',', @SELECTORS); } -sub sanity_check () { +sub sanity_check() { unless ($MailDir) { im_die("config files\n" . "Please setup user profile \"$IM_USER_PROFILE\".\n" . @@ -505,14 +507,13 @@ sub sanity_check () { } } -sub help ($) -{ +sub help($) { my $explanation = shift; - my ($name, $spec, $desc, $abbr, $dflt); + my($name, $spec, $desc, $abbr, $dflt); print "${explanation}\nOptions are: \n"; - foreach $name (@O_IORD){ + foreach $name (@O_IORD) { next unless (defined($O_HELP{$name})); $desc = $O_DESC{$name}; @@ -548,7 +549,11 @@ sub help ($) print "\t$name$spec $abbr($dflt)\n"; print "\t\t", $O_HELP{$name}, "\n"; } - print "\n* Note that +xxx is equivalent to $O_FOPT=+xxx\n\n" if $O_FOPT; + + if ($O_FOPT) { + print "\nNote that +xxx is equivalent to $O_FOPT=+xxx.\n"; + } + print "\nReport bugs to <img\@mew.org>.\n"; return 1; } @@ -556,10 +561,9 @@ sub help ($) ## ## -sub set_value_cfg ($$$) -{ - my ($name, $val, $case) = @_; - my ($mnam, $desc, $vnam); +sub set_value_cfg($$$) { + my($name, $val, $case) = @_; + my($mnam, $desc, $vnam); $val =~ s/\${(\w+)}/$ENV{$1}/ge; if ($val =~ /^\$(.*)/) { @@ -595,9 +599,8 @@ sub set_value_cfg ($$$) # set_value is not in safe manner. # see if $desc exists before calling this. -sub set_value ($$$$) -{ - my ($desc, $vnam, $val, $who) = @_; # b, $main::opt_help, yes +sub set_value($$$$) { + my($desc, $vnam, $val, $who) = @_; # b, $main::opt_help, yes # require numeric but not numeric, return undef return undef if ($desc =~ /i/ && $val !~ /\d+/); @@ -607,7 +610,7 @@ sub set_value ($$$$) # -> @xxx = (foo, bar, gaz) my @val = split(',', $val); if ($desc =~ /F/) { # xxx how about f - my ($i, $N) = (0, scalar(@val)); + my($i, $N) = (0, scalar(@val)); while ($i < $N) { $val[$i] = "+$val[$i]" unless $val =~ /(^[+\-=%~\/])|(^[a-zA-Z]:)/; @@ -653,9 +656,8 @@ sub set_value ($$$$) return 1; } -sub set_value_case ($$$$) -{ - my ($desc, $vnam, $val, $case) = @_; # b, $main::opt_help, yes +sub set_value_case($$$$) { + my($desc, $vnam, $val, $case) = @_; # b, $main::opt_help, yes # require numeric but not numeric, return undef return undef if ($desc =~ /i/ && $val !~ /\d+/); @@ -685,62 +687,62 @@ sub set_value_case ($$$$) ### Config vs Default ### -sub current_dir () { +sub current_dir() { return $CURRENT_DIR; } -sub home_dir () { +sub home_dir() { return $HOME_DIR; } -sub conf_dir () { +sub conf_dir() { return $IM_USER_DIR; } -sub mail_dir () { +sub mail_dir() { return $MailDir; } -sub mail_path () { +sub mail_path() { return expand_home(mail_dir()); } -sub news_dir () { +sub news_dir() { return $NewsDir; } -sub news_path () { +sub news_path() { return expand_home(news_dir()); } -sub queue_dir () { +sub queue_dir() { return $QueueDir; } -sub queue_path () { +sub queue_path() { expand_path(queue_dir()); } -sub inbox_folder (;$) { - my ($case) = split(',', shift); ## use the first one only +sub inbox_folder(;$) { + my($case) = split(',', shift); ## use the first one only if (defined($case) && $case ne 'default' && defined($case->{InboxFolder}) && - $case->{InboxFolder} ne ''){ + $case->{InboxFolder} ne '') { return $case->{InboxFolder}; } else { return $InboxFolder; } } -sub draft_folder () { +sub draft_folder() { return $DraftFolder; } -sub trash_folder () { +sub trash_folder() { return $TrashFolder; } -sub config_cases () { +sub config_cases() { my @cases = keys(%CASES); if (scalar(@cases) >= 2) { return join(',', @cases); @@ -749,7 +751,7 @@ sub config_cases () { } } -sub config_case_inbox () { +sub config_case_inbox() { my @cases = keys(%CASES); my @caseinbox = (); if (scalar(@cases) >= 2) { @@ -764,11 +766,11 @@ sub config_case_inbox () { } } -sub preserve_dot () { +sub preserve_dot() { return $PreserveDot; } -sub folder_mode ($) { +sub folder_mode($) { my $setumask = shift; $FolderMode = oct($FolderMode) if ($FolderMode =~ /^0\d/); @@ -777,7 +779,7 @@ sub folder_mode ($) { return $FolderMode; } -sub msg_mode ($) { +sub msg_mode($) { my $setumask = shift; $MsgMode = oct($MsgMode) if ($MsgMode =~ /^0\d/); @@ -786,175 +788,191 @@ sub msg_mode ($) { return $MsgMode; } -sub allowcrlf () { +sub allowcrlf() { return $AllowCRLF; } -sub use_cl () { +sub use_cl() { return $UseCL; } -sub no_sync () { +sub no_sync() { return $NoSync; } -sub fsync_no () { - return $FSYNC_NO; +sub fsync_no() { + return $FsyncNumber || $FSYNC_NO; } -sub addrbook_file () { +sub addrbook_file() { return join(',', map {expand_path($_)} split(',', $AddrBookFile)); } -sub aliases_file () { +sub aliases_file() { return join(',', map {expand_path($_)} split(',', $AliasesFile)); } -sub context_file () { +sub context_file() { return &expand_path($ContextFile); } -sub getchksbr_file () { +sub getchksbr_file() { return &expand_path($GetChkSbrFile); } -sub getsbr_file () { +sub getsbr_file() { return &expand_path($GetSbrFile); } -sub scansbr_file () { +sub scansbr_file() { return &expand_path($ScanSbrFile); } -sub scan_header_pick () { +sub scan_header_pick() { return $ScanHeaderPick; } -sub petname_file () { +sub petname_file() { return &expand_path($PetNameFile); } -sub address () { +sub address() { return $Address; } -sub addresses_regex () { +sub addresses_regex() { return $AddrRegex; } -sub msgdbfile () { +sub msgdbfile() { return &expand_path($MsgDBFile); } -sub msgdbtype () { +sub msgdbtype() { return $MsgDBType; } -sub mbox_style () { +sub mbox_style() { return $MBoxStyle; } -sub nntpservers () { +sub nntpservers() { return $NNTPservers; } -sub nntphistoryfile () { +sub nntphistoryfile() { return &expand_path($NNTPhistory); } -sub nntpauthuser () { +sub nntpauthuser() { return $NNTPauthuser; } sub set_nntpauthuser($) { - $NNTPauthuser = shift; + $NNTPauthuser = shift; } -sub popaccount () { +sub popaccount() { return $POPaccount; } -sub pophistoryfile () { +sub pophistoryfile() { return &expand_path($POPhistory); } -sub imapaccount () { +sub imapaccount() { return $IMAPaccount; } -sub httpproxy () { +sub httpproxy() { return $HTTPproxy; } -sub noproxy () { +sub noproxy() { return $Noproxy; } -sub usepwagent () { +sub usepwagent() { return $UsePwAgent; } -sub pwagentport () { +sub pwagentport() { return $PwAgentPort; } -sub usepwfiles () { +sub pwagent_tmp_dir() { + return $PwAgentTmpDir; +} + +sub pwagent_tmp_path() { + return expand_path(pwagent_tmp_dir()); +} + +sub usepwfiles() { return $UsePwFiles; } -sub pwfiles () { +sub pwfiles() { return $PwFiles; } -sub usetouchfile () { +sub usetouchfile() { return $UseTouchFile; } -sub touchfile () { +sub touchfile() { return $TouchFile; } -sub pop_timeout () { +sub pop_timeout() { return $PopTimeout; } -sub imap_timeout () { +sub imap_timeout() { return $ImapTimeout; } -sub nntp_timeout () { +sub nntp_timeout() { return $NntpTimeout; } -sub dns_timeout () { +sub dns_timeout() { return $DnsTimeout; } -sub connect_timeout () { +sub connect_timeout() { return $ConnectTimeout; } -sub command_timeout () { +sub command_timeout() { return $CommandTimeout; } -sub rcv_buf_siz () { +sub rcv_buf_siz() { return $RcvBufSiz; } -sub db_type () { +sub db_type() { return $IM_DB_TYPE; } -sub namazuv2 () { +sub namazuv2() { return $NamazuV2; } +sub namazu_lock_dir() { + return $NamazuLockDir; +} + +sub namazu_lock_path() { + return expand_path(namazu_lock_dir()); +} + ### ### path expansion ### -sub expand_home ($) { +sub expand_home($) { my $folder = shift; return '' if ($folder eq ''); @@ -970,7 +988,7 @@ sub expand_home ($) { return $folder; } -sub expand_path ($) { +sub expand_path($) { my $folder = shift; $folder =~ s/^\s*(.*?)\s*$/$1/; # SPC may be used in folder names @@ -1054,10 +1072,60 @@ QueueDir=queue # relative to ~/.im/ Imget.Src=local # default source of imget (local mailbox) PopHistory=pophist-{POPSERVERID} # to save last state (relative to ~/.im/) NntpHistory=newshist # to save last state (relative to ~/.im/) +# impwagent +PwAgentTmpDir=pwagtmp # temporary directory (relative to ~/.im/) # namazu -NamazuV2=off # use Namazu version2 (1.9.x or late) +NamazuV2=off # use Namazu version 2 (1.9.x or late) +NamazuLockDir=nmzlock # lock directory (relative to ~/.im/) __END__ +=head1 NAME + +IM::Config - confiugration for IM + +=head1 SYNOPSIS + + use IM::Config; + +Subroutines: +read_cfg_selector +init_opt +read_env read_cfg read_opt +set_selector used_selectors +sanity_check +help +home_dir conf_dir +mail_dir mail_path news_dir news_path queue_dir queue_path +inbox_folder draft_folder trash_folder config_cases config_case_inbox +preserve_dot +folder_mode msg_mode allowcrlf use_cl no_sync fsync_no +addrbook_file aliases_file petname_file +context_file getchksbr_file getsbr_file scansbr_file scan_header_pick +address addresses_regex +msgdbfile msgdbtype +mbox_style +nntpservers nntphistoryfile nntpauthuser set_nntpauthuser +popaccount pophistoryfile imapaccount httpproxy noproxy +usepwagent pwagentport pwagent_tmp_dir pwagent_tmp_path usepwfiles pwfiles +expand_path usetouchfile touchfile namazuv2 namazu_lock_dir namazu_lock_path +pop_timeout imap_timeout nntp_timeout dns_timeout +connect_timeout command_timeout rcv_buf_siz +db_type file_attr + +=head1 DESCRIPTION + +The I<IM::Config> module is for configuration of IM. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/EncDec.pm b/img/dist/IM/IM/EncDec.pm index acc1b9a0..11ac71cb 100644 --- a/img/dist/IM/IM/EncDec.pm +++ b/img/dist/IM/IM/EncDec.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::EncDec.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::EncDec.pm version 20021207(IM142)"; package IM::EncDec; require 5.003; @@ -23,40 +23,6 @@ use vars qw(@ISA @EXPORT); b_encode_string b_decode_string q_encode_string q_decode_string); -=head1 NAME - -EncDec - MIME header encoder/decoder - -=head1 SYNOPSIS - - use IM::EncDec; - - $mime_header_encoded_string = - mime_encode_string(string, iso7bit, iso8bit); - $string = - mime_decode_string(mime_header_encoded_string); - - $B_encoded_string = b_encode_string(string); - $string = b_decode_string(B_encoded_string); - - $Q_encoded_string = q_encode_string(string); - $string = q_decode_string(Q_encoded_string); - -=head1 DESCRIPTION - -MIME header encoder/decoder package. - - $_ = "JAPANESE (Kazuhiko Yamamoto)"; - mime_encode_string($_, 'iso-2022-jp', 'iso-8859-1'); - => =?iso-2022-jp?B?GyRCOzNLXE9CSScbKEI=?= - (Kazuhiko Yamamoto) - - s/\n[\t ]+//g; - print mime_decode_string($_), "\n"; - => "JAPANESE (Kazuhiko Yamamoto)" - -=cut - use vars qw(@D2H $mime_encode_switch $mime_decode_switch @@ -90,7 +56,7 @@ $mime_decode_switch = { ## String Encoder/Decoder ## -sub mime_encode_string ($$$) { +sub mime_encode_string($$$) { my($str, $iso7, $iso8) = (@_); my($point, $len, $nstr, $s) = (0, length($str), '', ''); my($single, $double) = ('', ''); @@ -155,12 +121,12 @@ sub mime_encode_string ($$$) { return $nstr; } -sub mime_decode_string ($) { +sub mime_decode_string($) { my $in = shift; return '' if ($in eq ''); if (!$main::opt_mimedecodequoted) { if ($in =~ /^([^"]*)("[^"]*")([\0-\255]*)$/) { - return mime_decode_string($1) . $2 . mime_decode_string($3); + return &mime_decode_string($1) . $2 . &mime_decode_string($3); } } $in =~ s/\?=\s+=\?/?==?/g; @@ -170,7 +136,7 @@ sub mime_decode_string ($) { } sub mime_decode($$$) { - my ($cs, $bq, $str) = @_; + my($cs, $bq, $str) = @_; my $ret = &{$$mime_decode_switch{uc($3)}}($4); if ($cs =~ /iso-8859-([2-9])/i) { $ret = iso_8859_to_ctext($ret, $1); @@ -194,8 +160,8 @@ sub mime_decode($$$) { return $ret; } -sub iso_8859_to_ctext ($$) { - my ($str, $num) = @_; +sub iso_8859_to_ctext($$) { + my($str, $num) = @_; my @index = ("A", "A", "B", "C", "D", "L", "G", "F", "H", "M"); $str =~ s/([\x80-\xff]+)/\e-$index[$num]$1\e-A/g; return $str; @@ -217,9 +183,9 @@ sub iso_8859_to_ctext ($$) { "\xce", "\xb0", "\xb1", "\xc6", "\xb4", "\xb5", "\xc4", "\xb3", "\xc5", "\xb8", "\xb9", "\xba", "\xbb", "\xbc", "\xbd", "\xbe", "\xbf", "\xcf", "\xc0", "\xc1", "\xc2", "\xc3", "\xb6", "\xb2", - "\xcc", "\xcb", "\xb7", "\xc8", "\xcd", "\xc9", "\xc7", "\xca" ); + "\xcc", "\xcb", "\xb7", "\xc8", "\xcd", "\xc9", "\xc7", "\xca"); -sub koi2iso ($) { +sub koi2iso($) { my $str = shift; $str =~ s/(.)/$koi_iso[ord($1)-128]/ge; return $str; @@ -232,12 +198,12 @@ sub koi8r_to_ctext($) { } sub tis_620_to_ctext($) { - my ($str) = shift; + my($str) = shift; $str =~ s/([\x80-\xff]+)/\e-T$1\e-A/g; return $str; } -sub cn_gb_to_ctext ($) { +sub cn_gb_to_ctext($) { my $str = shift; $str =~ s/([\x80-\xff]+)/"\e\$(A" . remove_msb($1) . "\e(B"/ge; return $str; @@ -251,7 +217,7 @@ sub hz_to_ctext($) { return $str; } -sub euc_jp_to_ctext ($) { +sub euc_jp_to_ctext($) { my $str = shift; $str =~ s/((\x8f[\xa0-\xff][\xa0-\xff])+)/"\e\$(D" . remove_msb(remove_ss($1, "\x8f")) . "\e-A"/ge; @@ -261,25 +227,25 @@ sub euc_jp_to_ctext ($) { return $str; } -sub euc_kr_to_ctext ($) { +sub euc_kr_to_ctext($) { my $str = shift; $str =~ s/([\x80-\xff]+)/"\e\$(C" . remove_msb($1) . "\e(B"/ge; return $str; } -sub remove_msb ($) { +sub remove_msb($) { my $str = shift; $str =~ tr/\x80-\xff/\x00-\x7f/; return $str; } -sub remove_ss ($$) { - my ($str, $si) = @_; +sub remove_ss($$) { + my($str, $si) = @_; $str =~ s/$si//g; return $str; } -sub shift_jis_to_ctext ($) { +sub shift_jis_to_ctext($) { my $str = shift; my $kanji = "[\x81-\x9f\xe0-\xef]."; my $kana = "[\xa0-\xdf]"; @@ -292,7 +258,7 @@ sub shift_jis_to_ctext ($) { sub s2j($) { my $str = shift; - my ($c1, $c2); + my($c1, $c2); my $ret = ""; while ($str) { @@ -311,9 +277,9 @@ sub s2j($) { return $ret; } -sub b157to94 ($) { +sub b157to94($) { my $str = shift; - my ($c1, $c2, $tmp); + my($c1, $c2, $tmp); my $ret = ""; while ($str) { @@ -350,14 +316,14 @@ sub big5_to_ctext($) { ## B Encoder/Decoder ## -sub b_encode_string ($) { +sub b_encode_string($) { my $mod3 = length($_[0]) % 3; local($_); $_ = pack('u', $_[0]); chop; s/(^|\n).//mg; - tr[`!-_][A-Za-z0-9+/]; + tr[`!-_][A-Za-z0-9+/]; #` if ($mod3 == 1) { s/..$/==/; } elsif ($mod3 == 2) { s/.$/=/; } @@ -365,7 +331,7 @@ sub b_encode_string ($) { $_; } -sub b_decode_string ($) { +sub b_decode_string($) { my $s64 = shift; my $len; my $res = ''; @@ -378,7 +344,7 @@ sub b_decode_string ($) { if (/(=+)$/) { $len -= length($1); } - tr[A-Za-z0-9+/=][`!-_A]; + tr[A-Za-z0-9+/=][`!-_A]; #` $res .= sprintf("%c%s\n", $len + 32, $_); } @@ -390,7 +356,7 @@ sub b_decode_string ($) { ## Q Encoder/Decoder ## -sub q_encode_string ($;$) { +sub q_encode_string($;$) { my($line, $struct) = @_; local($_); @@ -404,7 +370,7 @@ sub q_encode_string ($;$) { $_; } -sub q_decode_string ($) { +sub q_decode_string($) { my($qstr) = @_; local($_); @@ -416,6 +382,52 @@ sub q_decode_string ($) { 1; +__END__ + +=head1 NAME + +IM::EncDec - MIME header encoder/decoder + +=head1 SYNOPSIS + + use IM::EncDec; + + $mime_header_encoded_string = + mime_encode_string(string, iso7bit, iso8bit); + $string = + mime_decode_string(mime_header_encoded_string); + + $B_encoded_string = b_encode_string(string); + $string = b_decode_string(B_encoded_string); + + $Q_encoded_string = q_encode_string(string); + $string = q_decode_string(Q_encoded_string); + +=head1 DESCRIPTION + +The I<IM::EncDec> module is encoder/decoder for MIME header. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + $_ = "JAPANESE (Kazuhiko Yamamoto)"; + mime_encode_string($_, 'iso-2022-jp', 'iso-8859-1'); + => =?iso-2022-jp?B?GyRCOzNLXE9CSScbKEI=?= + (Kazuhiko Yamamoto) + + s/\n[\t ]+//g; + print mime_decode_string($_), "\n"; + => "JAPANESE (Kazuhiko Yamamoto)" + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/File.pm b/img/dist/IM/IM/File.pm index 0b6c1583..303ab310 100644 --- a/img/dist/IM/IM/File.pm +++ b/img/dist/IM/IM/File.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Jul 7, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::File.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::File.pm version 20021207(IM142)"; package IM::File; require 5.003; @@ -24,24 +24,18 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(im_rename im_link im_unlink); -## im_rename(path1, path2); -## im_link (path1, path2); -## im_unlink(path1); -## -## paths may be full-path or [+=]folder../../message. - use vars qw($CHECKED $USE_DB); -sub im_rename ($$) { - my ($p1, $p2) = @_; - my ($m1, $m2); - my ($ret); +sub im_rename($$) { + my($p1, $p2) = @_; + my($m1, $m2); + my($ret); ($p1, $m1) = expand_path_and_msg($p1); ($p2, $m2) = expand_path_and_msg($p2); - #my ($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); + #my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); #XXX??? - my ($id); + my($id); if (defined($main::id) || $main::opt_noharm) { $id = $main::id; } else { @@ -52,7 +46,7 @@ sub im_rename ($$) { print "mv $p1 $p2\n"; $ret = 1; } else { - if (!($ret = rename($p1, $p2))){ + if (!($ret = rename($p1, $p2))) { $ret = copy($p1, $p2) && unlink($p1); } history_rename($id, $m1, $m2) @@ -61,15 +55,15 @@ sub im_rename ($$) { return $ret; } -sub im_link ($$) { - my ($p1, $p2) = @_; - my ($m1, $m2); - my ($ret); +sub im_link($$) { + my($p1, $p2) = @_; + my($m1, $m2); + my($ret); ($p1, $m1) = expand_path_and_msg($p1); ($p2, $m2) = expand_path_and_msg($p2); - #my ($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); - my ($id); + #my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); + my($id); if (defined($main::id) || $main::opt_noharm) { $id = $main::id; } else { @@ -80,7 +74,7 @@ sub im_link ($$) { print "ln $p1 $p2\n"; $ret = 1; } else { - if (win95p() || os2p() || wntp() || !($ret = link($p1, $p2))){ + if (win95p() || os2p() || wntp() || !($ret = link($p1, $p2))) { $ret = copy($p1, $p2); } history_link($id, $m1, $m2) @@ -89,15 +83,14 @@ sub im_link ($$) { return $ret; } -sub im_unlink ($) -{ - my ($p1) = @_; - my ($m1, $ret); +sub im_unlink($) { + my($p1) = @_; + my($m1, $ret); ($p1, $m1) = expand_path_and_msg($p1); - # my ($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); - my ($id); + # my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); + my($id); if (defined($main::id) || $main::opt_noharm) { $id = $main::id; } else { @@ -120,14 +113,13 @@ sub im_unlink ($) ## ## Private. ## -sub get_msg_info ($) -{ - my ($p, $m) = expand_path_and_msg(shift); - my ($id, $date, $hdr); +sub get_msg_info($) { + my($p, $m) = expand_path_and_msg(shift); + my($id, $date, $hdr); local $/ = ''; - if (im_open(\*MSG, "<$p")){ - $hdr = <MSG>; close(MSG); + if (im_open(\*MSG, "<$p")) { + $hdr = <MSG>; close(MSG); } else { im_warn("no message id in $m.\n"); return undef; @@ -142,9 +134,9 @@ sub get_msg_info ($) return ($id); } -sub unexpand_path ($) { +sub unexpand_path($) { my $path = shift; - my ($mail_path, $news_path) = (mail_path(), news_path()); + my($mail_path, $news_path) = (mail_path(), news_path()); $path =~ s!^$mail_path/*!\+!; $path =~ s!^$news_path/*!\=!; @@ -152,12 +144,12 @@ sub unexpand_path ($) { return $path; } -sub expand_path_and_msg ($) { +sub expand_path_and_msg($) { my $path_or_msg = shift; return (expand_path($path_or_msg), unexpand_path($path_or_msg)); } -sub USE_DB () { +sub USE_DB() { if (!$CHECKED) { $CHECKED = 1; if ($USE_DB = msgdbfile()) { @@ -172,6 +164,36 @@ sub USE_DB () { 1; +__END__ + +=head1 NAME + +IM::File - mail/news file handler + +=head1 SYNOPSIS + + use IM::File; + + im_rename(path1, path2); + im_link(path1, path2); + im_unlink(path1); + +Paths may be full-path or [+=]folder../../message. + +=head1 DESCRIPTION + +The I<IM::File> module handles mail/news message files. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Folder.pm b/img/dist/IM/IM/Folder.pm index 572e8b8d..6170a4ee 100644 --- a/img/dist/IM/IM/Folder.pm +++ b/img/dist/IM/IM/Folder.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Folder.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Folder.pm version 20021207(IM142)"; package IM::Folder; require 5.003; @@ -26,58 +26,11 @@ use vars qw(@ISA @EXPORT); get_message_paths create_folder touch_folder chk_folder_existance chk_msg_existance get_impath); -=head1 NAME - -Folder - IM folder handler - -=head1 DESCRIPTION - - -=head1 SYNOPSIS - -use IM::Folder; - -$current_folder_name = &cur_folder(); - -&set_cur_folder($new_current_folder_name); - -($number_of_files, - $number_of_message_files, - $minimum_message_number, - $maximum_message_number) = &folder_info($folder_name); - -$message_number = &message_number($message_number_or_name); - -@message_number_array = &message_range($message_range_string); - -$message_file_path = &message_name($folder_name, $message_number); - -=head1 DESCRIPTION - -&cur_folder(); - results "+inbox" - -&set_cur_folder("+inbox"); - -($a, $b, $c, $d) = &folder_info("+inbox"); - results (10, 3, 1, 3) - -&message_number("+inbox", "cur"); - results 3 - -&message_range("+inbox", "1-3"); - results (1, 2, 3) - -&message_name("+inbox", "3"); - results "/usr/home/itojun/Mail/inbox/3" - -=cut - # # Mail folder related routines. # -sub cur_folder () { +sub cur_folder() { my $folder; local(*IN); @@ -95,7 +48,7 @@ sub cur_folder () { return $folder; } -sub set_cur_folder ($) { +sub set_cur_folder($) { my($folder) = @_; local(*IN, *OUT); my($buf); @@ -118,7 +71,7 @@ sub set_cur_folder ($) { close(OUT); } -sub folder_info ($) { +sub folder_info($) { my($folder) = @_; local(*DIR); my(@allfiles, $filecnt, $numfilecnt, $min, $max); @@ -135,8 +88,8 @@ sub folder_info ($) { return ($filecnt, $numfilecnt, $min, $max); } -sub message_list ($) { - my ($folder_dir) = @_; +sub message_list($) { + my($folder_dir) = @_; my @filesinfolder; opendir(DIR, $folder_dir) || im_die("can't open $folder_dir.\n"); @@ -146,9 +99,9 @@ sub message_list ($) { return @filesinfolder; } -sub message_number ($$;@) { - my ($folder, $number, @filesinfolder) = @_; - my ($folder_dir, $offset, $max, $min); +sub message_number($$;@) { + my($folder, $number, @filesinfolder) = @_; + my($folder_dir, $offset, $max, $min); # simple case: digits if ($number !~ /\D/) { @@ -158,7 +111,7 @@ sub message_number ($$;@) { # get folder $folder = cur_folder if ($folder eq ''); $folder_dir = expand_path($folder); - return '' if (!-d $folder_dir); + return '' if (! -d $folder_dir); @filesinfolder = message_list($folder_dir) if (scalar(@_) == 2); @@ -203,8 +156,8 @@ sub message_number ($$;@) { return ''; } -sub message_range ($$@) { - my ($folder, $range, @filesinfolder) = @_; +sub message_range($$@) { + my($folder, $range, @filesinfolder) = @_; my $range_regexp = '\d+|first|last|next|prev'; $folder = cur_folder if ($folder eq ''); @@ -215,7 +168,7 @@ sub message_range ($$@) { } if ($range =~ /^($range_regexp|new)-($range_regexp|new)$/) { - my ($start, $end) = ($1, $2); + my($start, $end) = ($1, $2); $start = message_number($folder, $start, @filesinfolder); $end = message_number($folder, $end, @filesinfolder); @@ -226,7 +179,7 @@ sub message_range ($$@) { return grep($start <= $_ && $_ <= $end, @filesinfolder); } } elsif ($range =~ /^($range_regexp):([+-]?)(\d+)$/) { - my ($start, $dir, $n) = ($1, $2, $3); + my($start, $dir, $n) = ($1, $2, $3); if ($dir eq '') { $dir = ($start eq 'last') ? '-' : '+'; } @@ -247,7 +200,7 @@ sub message_range ($$@) { } } -sub message_name ($$) { +sub message_name($$) { my($folder, $number) = @_; $number = &message_number($folder, $number); @@ -258,9 +211,9 @@ sub message_name ($$) { } } -sub get_message_paths ($@) { - my ($folder, @messages0) = @_; # local @messages0? - my ($i, @messages, @x); # local(@messages, @x);? +sub get_message_paths($@) { + my($folder, @messages0) = @_; # local @messages0? + my($i, @messages, @x); # local(@messages, @x);? my $folder_dir = &expand_path($folder); @@ -272,7 +225,7 @@ sub get_message_paths ($@) { # messages specified. # print the path to the message. - if (!-d $folder_dir) { + if (! -d $folder_dir) { $@ = "no such folder $folder"; return (); } @@ -305,7 +258,7 @@ sub get_message_paths ($@) { grep($_ = "$folder_dir/$_", @messages); } -sub create_folder ($) { +sub create_folder($) { my $folder = shift; my $path = &expand_path($folder); return 0 if (-d $path); @@ -331,9 +284,9 @@ sub create_folder ($) { return 0; } -sub touch_folder ($) { +sub touch_folder($) { if (&usetouchfile()) { - my ($dir) = shift; + my($dir) = shift; $dir =~ s/\/\d+$//; $dir = &expand_path($dir); my($file) = ($dir . "/" . &touchfile()); @@ -341,7 +294,7 @@ sub touch_folder ($) { print OF "touched by IM."; close(OF); } elsif (&os2p) { - my ($dir) = shift; + my($dir) = shift; $dir =~ s/\/\d+$//; $dir = &expand_path($dir); my $now = time; # XXX @@ -352,19 +305,19 @@ sub touch_folder ($) { ## ## Check folder existance. ## -sub chk_folder_existance (@) { +sub chk_folder_existance(@) { my @folders = @_; my $path; im_debug("chk_folder_existance: folder: @folders\n") if (&debug('all')); - foreach (@folders){ + foreach (@folders) { next if /^[%-]/; # skip IMAP and News folders $path = get_impath($_); if (-e $path) { im_die "folder $_ is not writable. (Nothing was refiled.)\n" - if (!-w $path); + if (! -w $path); } else { if (create_folder($path) == 0) { im_warn "created folder $_.\n"; @@ -376,20 +329,21 @@ sub chk_folder_existance (@) { im_debug("chk_folder_existance: OK.\n") if (&debug('all')); } -sub chk_msg_existance ($@) { +sub chk_msg_existance($@) { my $folder = shift; my @paths = get_impath($folder, @_); im_debug("chk_msg_existance: folder: $folder msg: @_\n") if (&debug('all')); - foreach (@paths){ - im_die "message specification error in $folder. (Nothing was refiled.)\n" - if (!-f $_); + foreach (@paths) { + if (! -f $_) { + im_die "message specification error in $folder. (Nothing was refiled.)\n"; + } } im_debug("chk_msg_existance: OK.\n") if (&debug('all'));; } -sub get_impath ($@) { +sub get_impath($@) { my $folder = shift; my @msgs = @_; my @paths; @@ -403,6 +357,64 @@ sub get_impath ($@) { 1; +__END__ + +=head1 NAME + +IM::Folder - mail/news folder handler + +=head1 SYNOPSIS + + use IM::Folder; + + $current_folder_name = &cur_folder(); + + &set_cur_folder($new_current_folder_name); + + ($number_of_files, + $number_of_message_files, + $minimum_message_number, + $maximum_message_number) = &folder_info($folder_name); + + $message_number = &message_number($message_number_or_name); + + @message_number_array = &message_range($message_range_string); + + $message_file_path = &message_name($folder_name, $message_number); + +=head1 DESCRIPTION + +The I<IM::Folder> module handles mail/news message folders. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + &cur_folder(); + results "+inbox" + + &set_cur_folder("+inbox"); + + ($a, $b, $c, $d) = &folder_info("+inbox"); + results (10, 3, 1, 3) + + &message_number("+inbox", "cur"); + results 3 + + &message_range("+inbox", "1-3"); + results (1, 2, 3) + + &message_name("+inbox", "3"); + results "/usr/home/itojun/Mail/inbox/3" + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/GetPass.pm b/img/dist/IM/IM/GetPass.pm index ec252fbf..6c4caf5f 100644 --- a/img/dist/IM/IM/GetPass.pm +++ b/img/dist/IM/IM/GetPass.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 30, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::GetPass.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::GetPass.pm version 20021207(IM142)"; package IM::GetPass; require 5.003; @@ -24,19 +24,7 @@ use vars qw(@ISA @EXPORT); @EXPORT = qw(getpass getpass_interact loadpass savepass connect_agent talk_agent findpass); -=head1 NAME - -GetPass - Get password from tty or ... - -=head1 SYNOPSIS - -($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); - -=head1 DESCRIPTION - -=cut - -sub getpass ($$$$) { +sub getpass($$$$) { my($proto, $auth, $host, $user) = @_; my $pass = ''; my $agtfound = 0; @@ -57,14 +45,14 @@ sub getpass ($$$$) { return ($pass, $agtfound, $interact); } -sub getpass_interact ($) { - my ($prompt) = @_; - my ($secret, $termios, $c_lflag); +sub getpass_interact($) { + my($prompt) = @_; + my($secret, $termios, $c_lflag); if (! -t STDIN) { # stty is not effective for Mule since it's not terminal base. # Anyway, Mew never echos back even if getpass echos back. - } elsif (eval 'require POSIX' & ! win95p() ) { + } elsif (eval 'require POSIX' & !win95p()) { import POSIX qw(termios_h); $termios = new POSIX::Termios; $termios->getattr(fileno(STDIN)); @@ -73,7 +61,7 @@ sub getpass_interact ($) { $termios->setattr(fileno(STDIN), &POSIX::TCSANOW); } elsif (unixp()) { # non-POSIX-ish UNIX. # stty might be available. - my ($OldPath) = $ENV{'PATH'}; # for SUID version + my($OldPath) = $ENV{'PATH'}; # for SUID version $ENV{'PATH'} = '/bin:/usr/bin'; system('/bin/stty -echo'); # Ignore errors. $ENV{'PATH'} = $OldPath; @@ -92,7 +80,7 @@ sub getpass_interact ($) { $termios->setlflag($c_lflag); $termios->setattr(fileno(STDIN), &POSIX::TCSANOW); } elsif (unixp()) { # non-POSIX-ish UNIX. - my ($OldPath) = $ENV{'PATH'}; # for SUID version + my($OldPath) = $ENV{'PATH'}; # for SUID version $ENV{'PATH'} = '/bin:/usr/bin'; system('/bin/stty echo'); # Ignore errors. $ENV{'PATH'} = $OldPath; @@ -101,9 +89,9 @@ sub getpass_interact ($) { return $secret; } -sub loadpass ($$$$) { - my ($proto, $auth, $path, $user) = @_; - local ($_); +sub loadpass($$$$) { + my($proto, $auth, $path, $user) = @_; + local($_); my $key = &connect_agent(0); return '' if ($key eq ''); my @keys = unpack('C*', $key); @@ -124,9 +112,9 @@ sub loadpass ($$$$) { } } -sub savepass ($$$$$) { - my ($proto, $auth, $path, $user, $pass) = @_; - local ($_); +sub savepass($$$$$) { + my($proto, $auth, $path, $user, $pass) = @_; + local($_); my $key = &connect_agent(0); return '' if ($key eq ''); my @keys = unpack('C*', $key); @@ -141,8 +129,8 @@ sub savepass ($$$$$) { &talk_agent("SAVE\t$proto\t$auth\t$path\t$user\nPASS\t$pass\n", 0); } -sub connect_agent ($) { - my ($surpresserror) = shift; +sub connect_agent($) { + my($surpresserror) = shift; require Socket && import Socket; my $realuser = im_getlogin(); @@ -150,7 +138,7 @@ sub connect_agent ($) { im_warn("pwagent: can not get login name\n") unless ($surpresserror); return ''; } - my $dir = "/tmp/im-$realuser"; + my $dir = &pwagent_tmp_path() . "-$realuser"; my $port = &pwagentport(); if ($port > 0) { @@ -172,7 +160,7 @@ sub connect_agent ($) { return ''; } - my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev) = stat($dir); + my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev) = stat($dir); if ($mode & 0077) { im_warn("pwagent: invalid mode: $dir\n") unless ($surpresserror); return ''; @@ -199,8 +187,8 @@ sub connect_agent ($) { return $res; } -sub talk_agent ($) { - my ($msg) = shift; +sub talk_agent($) { + my($msg) = shift; print SOCK $msg; my $res = <SOCK>; shutdown (SOCK, 2); @@ -210,9 +198,9 @@ sub talk_agent ($) { } sub findpass($$$$) { - my ($proto, $auth, $host, $user) = @_; - local ($_); - my ($passfile); + my($proto, $auth, $host, $user) = @_; + local($_); + my($passfile); foreach $passfile (split(',', &pwfiles())) { $passfile = &expand_path($passfile); @@ -222,8 +210,8 @@ sub findpass($$$$) { next if (/^(#.*)?$/); # s/\s+(\#.*)?$//; # remove comments if (/^(\S+)\s+(\S+)\s+(\S+)\s+(\S.+)$/) { - my ($tmp_host, $tmp_user, $tmp_pass) = ($2, $3, $4); - my ($tmp_proto, $tmp_auth) = split('/', $1); + my($tmp_host, $tmp_user, $tmp_pass) = ($2, $3, $4); + my($tmp_proto, $tmp_auth) = split('/', $1); if (($tmp_proto eq $proto) && ($tmp_auth eq $auth) && ($tmp_host eq $host) @@ -241,6 +229,32 @@ sub findpass($$$$) { 1; +__END__ + +=head1 NAME + +IM::GetPass - get password from tty or ... + +=head1 SYNOPSIS + + use IM::GetPass; + + ($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); + +=head1 DESCRIPTION + +The I<IM::GetPass> module handles password for mail/news servers. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Grep.pm b/img/dist/IM/IM/Grep.pm index 32bf0c0f..20cfb878 100644 --- a/img/dist/IM/IM/Grep.pm +++ b/img/dist/IM/IM/Grep.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Nov 03, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Grep.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Grep.pm version 20021207(IM142)"; package IM::Grep; require 5.003; @@ -26,23 +26,6 @@ use vars qw(@ISA @EXPORT %MESSAGE_ID_HASH); @ISA = qw(Exporter); @EXPORT = qw(parse_expression grep_folder sortuniq); -=head1 NAME - -Grep - IM grep folder - -=head1 DESCRIPTION - - -=head1 SYNOPSIS - -use IM::Grep; - -$eval_string = &parse_expression($expression, $casefold); - -@message_number_array = &grep_folder($folder_dir, $eval_string, @ranges); - -=cut - ## ## Environments ## @@ -56,13 +39,13 @@ my $draft_delimiter = "\n----\n"; %MESSAGE_ID_HASH = (); -sub grep_folder ($$$@) { - my ($folder, $eval_string, $dup_check, @ranges) = @_; +sub grep_folder($$$@) { + my($folder, $eval_string, $dup_check, @ranges) = @_; my $folder_dir; my @src_msgs = (); my @messages = (); - if ( $folder =~ /^\-/ ) { + if ($folder =~ /^\-/) { im_warn("Newsspool $folder search not supported (ignored)\n"); } @@ -77,12 +60,12 @@ sub grep_folder ($$$@) { # collect message numbers my @filesinfolder = message_list($folder_dir); - foreach ( @ranges ) { + foreach (@ranges) { my @tmp = (); im_die("illegal range specification: $_\n") unless /^$range_regexp$/; im_debug("extract range $_\n") if &debug('all'); - if (( @tmp = message_range($folder, $_, @filesinfolder )) eq '') { + if ((@tmp = message_range($folder, $_, @filesinfolder)) eq '') { im_warn("message $_ out of range\n"); } push(@src_msgs, @tmp); @@ -181,8 +164,8 @@ sub EOL { 0; } sub LITERAL { 1; } sub SYMBOL { 2; } -sub parse_expression ($$) { - my ($expr, $casefold) = @_; +sub parse_expression($$) { + my($expr, $casefold) = @_; my $case_flag = ''; my $expr_string = ''; @@ -196,8 +179,8 @@ sub parse_expression ($$) { my $SYMBOLS = '[!()=]|\&\&?|\|\|?'; my @tokens = (); - my ($escape, $pos, $len) = (0) x 3; - my ($token, $quote) = ('') x 2; + my($escape, $pos, $len) = (0) x 3; + my($token, $quote) = ('') x 2; my $str; LEX: @@ -272,8 +255,8 @@ sub parse_expression ($$) { # 3: before pattern: LITERAL->1, fallback to 1 # - my ($status, $paren) = (0) x 2; - my ($field, $pattern, $string) = ('') x 3; + my($status, $paren) = (0) x 2; + my($field, $pattern, $string) = ('') x 3; # my $token; PARSE: @@ -372,7 +355,7 @@ sub parse_expression ($$) { } # simple check by perl interpreter - my ($head, $body, $all) = ('') x 3; + my($head, $body, $all) = ('') x 3; eval "$eval_string"; if ($@) { if ($main::opt_quiet) { @@ -389,7 +372,7 @@ sub parse_expression ($$) { } sub parse_die($$$) { - my ($die, $expr, $pos) = @_; + my($die, $expr, $pos) = @_; if (!$main::opt_quiet and !$main::opt_verbose) { im_die("$die in the expression\n"); } @@ -405,12 +388,12 @@ sub parse_die($$$) { ## sort and uniqify a list ## -sub sortuniq (@) { +sub sortuniq(@) { my(@target) = @_; my(%tmp); @tmp{@target} = (undef) x @target; - return ( sort {$a <=> $b} keys %tmp ); + return(sort {$a <=> $b} keys %tmp); } ################################################## @@ -465,6 +448,34 @@ sub make_japanese_pattern { 1; +__END__ + +=head1 NAME + +IM::Grep - grep mail/news folder + +=head1 SYNOPSIS + + use IM::Grep; + + $eval_string = &parse_expression($expression, $casefold); + + @message_number_array = &grep_folder($folder_dir, $eval_string, @ranges); + +=head1 DESCRIPTION + +The I<IM::Grep> module enumerates mail/news messages matched given patterns. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/History.pm b/img/dist/IM/IM/History.pm index dad0eb21..0fd358c2 100644 --- a/img/dist/IM/IM/History.pm +++ b/img/dist/IM/IM/History.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Jul 6, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::History.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::History.pm version 20021207(IM142)"; package IM::History; require 5.003; @@ -42,8 +42,8 @@ sub LookUpMsg { 0 } #sub LookUpDate { 1 } -sub history_open ($) { - my ($with_lock) = @_; +sub history_open($) { + my($with_lock) = @_; $DBtype = msgdbtype(); # package global unless ($DBtype) { $DBtype = db_type(); @@ -74,13 +74,13 @@ sub history_open ($) { im_debug("history database: $dbfile\n") if (&debug('history')); - my ($db, $fd); + my($db, $fd); if ($DBtype eq 'DB') { $db = tie %History, 'DB_File', $dbfile, O_CREAT()|O_RDWR(), &msg_mode(0); } elsif ($DBtype eq 'NDBM') { $db = tie %History, 'NDBM_File', $dbfile, O_CREAT()|O_RDWR(), &msg_mode(0); } elsif ($DBtype eq 'SDBM') { - if (&win95p || &os2p){ + if (&win95p || &os2p) { $db = tie %History, 'SDBM_File', $dbfile, O_CREAT()|O_RDWR()|O_BINARY(), &msg_mode(0); } else { $db = tie %History, 'SDBM_File', $dbfile, O_CREAT()|O_RDWR(), &msg_mode(0); @@ -112,7 +112,7 @@ sub history_open ($) { return -1; } } - if (! &win95p ){ + if (! &win95p) { unless (flock (HIST_FH, LOCK_EX | LOCK_NB)) { im_warn "history: waiting for write lock ($!)\n"; unless (flock (HIST_FH, LOCK_EX)) { @@ -126,12 +126,12 @@ sub history_open ($) { } -sub history_close () { +sub history_close() { if ($nodbfile) { im_err("no database specified.\n"); return; } - if (! &win95p ){ + if (! &win95p) { if ($locked) { flock(HIST_FH, LOCK_UN); } @@ -144,12 +144,12 @@ sub history_close () { } -sub history_lookup ($$) { +sub history_lookup($$) { if ($nodbfile) { im_err("no database specified.\n"); return (); } - my ($msgid, $field) = @_; + my($msgid, $field) = @_; $msgid =~ s/^<(.*)>$/$1/; if (defined($History{$msgid})) { if ($field == LookUpAll) { @@ -167,16 +167,16 @@ sub history_lookup ($$) { } } -sub history_store ($$) { +sub history_store($$) { if ($nodbfile) { im_err("no database specified.\n"); return -1; } - my ($msgid, $folder) = @_; + my($msgid, $folder) = @_; $msgid =~ s/^<(.*)>$/$1/; im_notice("add to history: $msgid\t$folder\n"); if (defined($History{$msgid})) { - my ($ofolder) = split("\t", $History{$msgid}); + my($ofolder) = split("\t", $History{$msgid}); if (scalar(grep($folder eq $_, split(',', $ofolder)))) { return; } @@ -185,17 +185,17 @@ sub history_store ($$) { $History{$msgid} = $folder; } -sub history_delete ($$) { +sub history_delete($$) { if ($nodbfile) { im_err("no database specified.\n"); return -1; } - my ($msgid, $folder) = @_; + my($msgid, $folder) = @_; $msgid =~ s/^<(.*)>$/$1/; if (defined($History{$msgid})) { if ($folder ne '') { - my ($f) = split("\t", $History{$msgid}); - my (@list, $found); + my($f) = split("\t", $History{$msgid}); + my(@list, $found); foreach (split(',', $f)) { if ($_ eq $folder) { $found = 1; @@ -221,25 +221,25 @@ sub history_delete ($$) { } -sub history_dump () { +sub history_dump() { if ($nodbfile) { im_err("no database specified.\n"); return; } - my ($key, $val); + my($key, $val); while (($key, $val) = each(%History)) { print "$key\t$val\n"; } } -sub history_rename ($$$) { +sub history_rename($$$) { if ($nodbfile) {im_err("no database specified.\n"); return;} - my ($id, $m1, $m2) = @_; + my($id, $m1, $m2) = @_; $id =~ s/<(.*)>/$1/; my $h; - if (defined $History{$id}){ + if (defined $History{$id}) { $h = $History{$id}; $h =~ s/^([^\t]+)(.*)//; $h = join(',', grep($_ ne $m1, split(',', $1)), $m2) . $2; @@ -251,14 +251,14 @@ sub history_rename ($$$) { return 0; } -sub history_link ($$$) { +sub history_link($$$) { if ($nodbfile) {im_err("no database specified.\n"); return;} - my ($id, $m1, $m2) = @_; + my($id, $m1, $m2) = @_; $id =~ s/<(.*)>/$1/; my $h; - if (defined $History{$id}){ + if (defined $History{$id}) { $h = $History{$id}; $h =~ s/^([^\t]+)(.*)//; $h = join(',', grep($_ ne $m2, split(',', $1)), $m2) . $2; @@ -270,13 +270,13 @@ sub history_link ($$$) { return 0; } -sub history_unlink ($$) { +sub history_unlink($$) { if ($nodbfile) {im_err("no database specified.\n"); return;} - my ($id, $m1) = @_; + my($id, $m1) = @_; $id =~ s/<(.*)>/$1/; - if (defined $History{$id}){ + if (defined $History{$id}) { my $h = $History{$id}; $h =~ s/^([^\t]+)(.*)//; $h = join(',', grep($_ ne $m1, split(',', $1))) . $2; @@ -293,6 +293,40 @@ sub history_unlink ($$) { 1; +__END__ + +=head1 NAME + +IM::History - mail/news history database handler + +=head1 SYNOPSIS + + use IM::History; + + history_open($with_lock); + history_dump(); + history_store($msgid, $folder); + history_lookup($msgid, LookUpAll); + history_lookup($msgid, LookUpMsg); + history_delete($msgid, $folder); + history_rename($id, $m1, $m2); + history_link($id, $m1, $m2); + history_close(); + +=head1 DESCRIPTION + +The I<IM::History> module handles mail/news database. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Http.pm b/img/dist/IM/IM/Http.pm index 59ff1f8d..34949b61 100644 --- a/img/dist/IM/IM/Http.pm +++ b/img/dist/IM/IM/Http.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Http.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Http.pm version 20021207(IM142)"; package IM::Http; require 5.003; @@ -23,16 +23,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(http_process http_spec); -=head1 NAME - -Http - HTTP handling package - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw(*HTTPd); ######################## @@ -48,10 +38,10 @@ use vars qw(*HTTPd); # 0: success # -1: failure # -sub http_open ($$) { - my ($host, $port) = @_; - my ($resp); - my (@host_list); +sub http_open($$) { + my($host, $port) = @_; + my($resp); + my(@host_list); if ($port ne '' && $port != 0 && $port != 80) { @host_list = ("$host/$port"); } else { @@ -67,16 +57,16 @@ sub http_open ($$) { return 0; } -sub http_close () { +sub http_close() { im_notice("closing HTTP session.\n"); close(HTTPd); return 0; } -sub http_get ($$$) { - my ($path, $user, $pass) = @_; - local ($_); - my (@Message); +sub http_get($$$) { + my($path, $user, $pass) = @_; + local($_); + my(@Message); im_notice("getting $path.\n"); &send_data(\*HTTPd, "GET $path HTTP/1.0", ''); if ($pass ne '') { @@ -94,11 +84,11 @@ sub http_get ($$$) { } # http_process(spec) -sub http_process ($;$$) { - my ($spec, $http_proxy, $no_proxy) = @_; - my ($msg, $rcode, $auth); - my ($user, $host, $port, $path); - my ($target_host, $target_port); +sub http_process($;$$) { + my($spec, $http_proxy, $no_proxy) = @_; + my($msg, $rcode, $auth); + my($user, $host, $port, $path); + my($target_host, $target_port); $http_proxy = '' if ($no_proxy && $spec =~ /$no_proxy/); @@ -190,7 +180,7 @@ sub http_process ($;$$) { } # HTTP (--src=http://[user@]server[:port]/path) -sub http_spec ($) { +sub http_spec($) { my $spec = shift; if ($spec eq '') { @@ -224,6 +214,45 @@ sub http_spec ($) { 1; +__END__ + +=head1 NAME + +IM::Http - HTTP handler + +=head1 SYNOPSIS + + use IM::Http; + + (rc, data) = http_process(spec, http_proxy, no_proxy) + rc: + 0: success + -1: failure + +=head1 DESCRIPTION + +The I<IM::Http> module handles HTTP. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + my($rc, $data) = http_process($spec, httpproxy(), noproxy()) + if ($rc < 0) { + exit 1; + } + foreach (@$data) { + print; + } + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Imap.pm b/img/dist/IM/IM/Imap.pm index 32583f9c..cdd056d6 100644 --- a/img/dist/IM/IM/Imap.pm +++ b/img/dist/IM/IM/Imap.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Imap.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Imap.pm version 20021207(IM142)"; package IM::Imap; require 5.003; @@ -32,16 +32,6 @@ use vars qw(@ISA @EXPORT); imap_put_message imap_put_file imap_refile imap_delete_message ); -=head1 NAME - -Imap - IMAP handling package - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw($ImapSeq); ######################## # IMAP access routines # @@ -52,10 +42,10 @@ use vars qw($ImapSeq); # 0: success # -1: failure # -sub imap_open ($$$$) { - my ($auth, $host, $user, $pass) = @_; - my ($data, $seq, $errmsg); - my (@host_list) = ($host); +sub imap_open($$$$) { + my($auth, $host, $user, $pass) = @_; + my($data, $seq, $errmsg); + my(@host_list) = ($host); my $HANDLE; $pass = '*' unless ($pass); @@ -72,7 +62,7 @@ sub imap_open ($$$$) { } my $failed = 0; if ($auth eq 'LOGIN') { - my ($us, $pw) = ($user, $pass); + my($us, $pw) = ($user, $pass); $us =~ s/([\\"])/\\$1/g; # escape specials $us = "\"$us\""; # quote it $pw =~ s/([\\"])/\\$1/g; # escape specials @@ -134,9 +124,9 @@ sub imap_open ($$$$) { return (0, $HANDLE); } -sub imap_close ($) { - my ($HANDLE) = @_; - my ($seq) = $ImapSeq++; +sub imap_close($) { + my($HANDLE) = @_; + my($seq) = $ImapSeq++; my $failed = 0; if (1) { im_notice("closing IMAP session.\n"); @@ -162,10 +152,10 @@ sub imap_close ($) { return 0; } -sub imap_select ($$$) { - my ($HANDLE, $mbox, $select) = @_; - my ($seq) = $ImapSeq++; - my ($resp, @field); +sub imap_select($$$) { + my($HANDLE, $mbox, $select) = @_; + my($seq) = $ImapSeq++; + my($resp, @field); if ($select) { im_notice("select mbox $mbox and getting number of message.\n"); $resp = &send_command($HANDLE, "im$seq SELECT $mbox", ''); @@ -195,10 +185,10 @@ sub imap_select ($$$) { return $msgs; } -sub imap_get ($$) { - my ($HANDLE, $num) = @_; - my ($seq) = $ImapSeq++; - my (@message); +sub imap_get($$) { + my($HANDLE, $num) = @_; + my($seq) = $ImapSeq++; + my(@message); im_notice("getting message $num.\n"); my $resp = &send_command($HANDLE, "im$seq UID FETCH $num RFC822", ''); my $failed = 0; @@ -236,18 +226,18 @@ sub imap_get ($$) { return (0, \@message); } -sub imap_head ($$) { - my ($HANDLE, $num) = @_; - my ($seq) = $ImapSeq++; +sub imap_head($$) { + my($HANDLE, $num) = @_; + my($seq) = $ImapSeq++; im_notice("getting header of message $num.\n"); my $resp = &send_command($HANDLE, "im$seq UID FETCH $num (RFC822.SIZE RFC822.HEADER)", ''); my $failed = 0; - my (%head); + my(%head); undef %head; if ($resp =~ /^\* \d+ FETCH \((UID $num )?RFC822.SIZE (\d+) RFC822.HEADER \{(\d+)\}/i) { - my ($size, $len) = ($2, $3); + my($size, $len) = ($2, $3); my $field = ''; alarm(imap_timeout()) unless win95p(); $! = 0; @@ -295,8 +285,8 @@ sub imap_head ($$) { return (0, \%head); } -sub imap_from ($$) { - my ($HANDLE, $num) = @_; +sub imap_from($$) { + my($HANDLE, $num) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("getting sender information of message $num.\n"); @@ -349,10 +339,10 @@ sub imap_from ($$) { return 0; } -sub imap_flags ($$) { - my ($HANDLE, $num) = @_; +sub imap_flags($$) { + my($HANDLE, $num) = @_; my $seq = $ImapSeq++; - my ($flags); + my($flags); im_notice("getting flags for $num.\n"); my $failed = 0; my $resp = &send_command($HANDLE, "im$seq UID FETCH $num FLAGS", ''); @@ -370,8 +360,8 @@ sub imap_flags ($$) { return $flags; } -sub imap_delete ($$) { - my ($HANDLE, $num) = @_; +sub imap_delete($$) { + my($HANDLE, $num) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("deleting message $num.\n"); @@ -386,13 +376,13 @@ sub imap_delete ($$) { return 0; } -sub imap_list_folder ($) { - my ($HANDLE) = @_; +sub imap_list_folder($) { + my($HANDLE) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("listing folders.\n"); my $resp = &send_command($HANDLE, "im$seq LIST \"\" *", ''); - my (@folders) = (); + my(@folders) = (); while ($resp !~ /^im$seq/) { $failed = 1 if ($resp =~ /^\* NO/i); if ($resp =~ /^\* LIST \(([^)]*)\) (\S+) (\S+)/) { @@ -407,8 +397,8 @@ sub imap_list_folder ($) { return @folders; } -sub imap_create_folder ($$) { - my ($HANDLE, $folder) = @_; +sub imap_create_folder($$) { + my($HANDLE, $folder) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("creating folder $folder.\n"); @@ -422,8 +412,8 @@ sub imap_create_folder ($$) { return 0; } -sub imap_delete_folder ($$) { - my ($HANDLE, $folder) = @_; +sub imap_delete_folder($$) { + my($HANDLE, $folder) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("deleting folder $folder.\n"); @@ -437,8 +427,8 @@ sub imap_delete_folder ($$) { return 0; } -sub imap_rename_folder ($$$) { - my ($HANDLE, $old, $new) = @_; +sub imap_rename_folder($$$) { + my($HANDLE, $old, $new) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("rename folder from $old to $new.\n"); @@ -452,8 +442,8 @@ sub imap_rename_folder ($$$) { return 0; } -sub imap_copy ($$$$) { - my ($HANDLE, $srcmsg, $dstfolder, $moveflag) = @_; +sub imap_copy($$$$) { + my($HANDLE, $srcmsg, $dstfolder, $moveflag) = @_; im_notice("copying message $srcmsg to $dstfolder.\n"); # my $resp = &imap_select($HANDLE, $dstfolder, 0); # if ($resp < 0) { @@ -480,8 +470,8 @@ sub imap_copy ($$$$) { return 0; } -sub imap_put ($$$) { - my ($HANDLE, $folder, $Msg) = @_; +sub imap_put($$$) { + my($HANDLE, $folder, $Msg) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("appending a new message to $folder.\n"); @@ -516,9 +506,9 @@ sub imap_put ($$$) { } # imap_process(handle, how, host, src, dst, limit) -sub imap_process ($$$$$$$) { - my ($HANDLE, $how, $host, $src, $dst, $limit, $noscan) = @_; - my ($msgs, $count) = (0, 0); +sub imap_process($$$$$$$) { + my($HANDLE, $how, $host, $src, $dst, $limit, $noscan) = @_; + my($msgs, $count) = (0, 0); if (($msgs = &imap_select($HANDLE, $src, 1)) < 0) { im_warn("selecting folder $src failed.\n"); return -1; @@ -553,7 +543,7 @@ sub imap_process ($$$$$$$) { im_info("$count message(s).\n"); return $count; } - my ($rc, $message) = &imap_get($HANDLE, $i); + my($rc, $message) = &imap_get($HANDLE, $i); return -1 if ($rc < 0); return -1 if (store_message($message, $dst, $noscan) < 0); &exec_getsbrfile($dst); @@ -573,17 +563,17 @@ sub imap_process ($$$$$$$) { return $msgs; } -sub imap_get_msg ($$$$$) { - my ($src, $dst, $how, $limit, $noscan) = @_; +sub imap_get_msg($$$$$) { + my($src, $dst, $how, $limit, $noscan) = @_; $src =~ s/^imap//i; - my ($folder, $auth, $user, $host) = &imap_spec($src); + my($folder, $auth, $user, $host) = &imap_spec($src); return -1 if ($folder eq ''); - my ($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); + my($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); im_notice("accessing IMAP/$auth:$user\@$host for $how\n"); - my ($rc, $HANDLE) = &imap_open($auth, $host, $user, $pass); + my($rc, $HANDLE) = &imap_open($auth, $host, $user, $pass); if ($rc == 0) { &savepass('imap', $auth, $host, $user, $pass) if ($pass ne '' && $interact && &usepwagent()); @@ -601,7 +591,7 @@ sub imap_get_msg ($$$$$) { } # IMAP folder (--src=imap[%folder][//auth][:user][@server[/port]]) -sub imap_spec ($) { +sub imap_spec($) { my $spec = shift; if ($spec eq '' || $spec !~ /[:\@]|\/\//) { @@ -619,7 +609,7 @@ sub imap_spec ($) { $spec .= $s if ($s ne ''); } - my ($folder, $auth, $host) = ('INBOX', 'auth', 'localhost'); + my($folder, $auth, $host) = ('INBOX', 'auth', 'localhost'); my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || im_getlogin(); if ($spec =~ /^%(.*)\/(\/.*)/) { @@ -658,13 +648,13 @@ sub imap_spec ($) { return ($folder, $auth, $user, $host); } -sub imap_range2set ($@) { - my ($HANDLE, @ranges) = @_; - my (@uids, $fromuid, $dir); +sub imap_range2set($@) { + my($HANDLE, @ranges) = @_; + my(@uids, $fromuid, $dir); my @alluids = &imap_all_uids($HANDLE); return -1 if ($alluids[0] < 0); - my ($min, $max) = ($alluids[0], $alluids[$#alluids]); + my($min, $max) = ($alluids[0], $alluids[$#alluids]); @ranges = ('first-last') if ($#ranges < 0 || grep(/^all$/, @ranges)); local $_; @@ -703,9 +693,9 @@ sub imap_range2set ($@) { return join(',', grep($_, @ranges)); } -sub imap_range2msgs ($@) { - my ($HANDLE, @ranges) = @_; - my ($seq, $set, $resp, @uids); +sub imap_range2msgs($@) { + my($HANDLE, @ranges) = @_; + my($seq, $set, $resp, @uids); $set = &imap_range2set($HANDLE, @ranges); $seq = $ImapSeq++; @@ -721,9 +711,9 @@ sub imap_range2msgs ($@) { return wantarray ? @uids : $uids[0]; } -sub imap_folder_regname ($) { +sub imap_folder_regname($) { my $folder = shift; # %... - my ($auth, $user, $host); + my($auth, $user, $host); ($folder, $auth, $user, $host) = imap_spec($folder); $folder =~ s/^/%/; @@ -731,7 +721,7 @@ sub imap_folder_regname ($) { return "$folder//$auth:$user\@$host"; # may be appended '/port' } -sub imap_folder_name ($) { +sub imap_folder_name($) { my $folder = shift; if ($folder =~ /^%([^:\@]+)/) { @@ -744,9 +734,9 @@ sub imap_folder_name ($) { return ''; } -sub imap_folder_acct ($) { +sub imap_folder_acct($) { my $folder = shift; # %... - my ($auth, $user, $host); + my($auth, $user, $host); ($folder, $auth, $user, $host) = imap_spec($folder); @@ -756,9 +746,9 @@ sub imap_folder_acct ($) { return ''; } -sub imap_all_uids ($) { - my ($HANDLE) = @_; - my ($seq, $resp, @uids); +sub imap_all_uids($) { + my($HANDLE) = @_; + my($seq, $resp, @uids); $seq = $ImapSeq++; $resp = &send_command($HANDLE, "im$seq UID SEARCH 1:*", ''); @@ -773,8 +763,8 @@ sub imap_all_uids ($) { return @uids; } -sub imap_message_number ($$$) { - my ($min, $max, $num) = @_; +sub imap_message_number($$$) { + my($min, $max, $num) = @_; return $num if $num =~ /^\d+$/; return $min if $num =~ /^first$/; @@ -787,9 +777,9 @@ sub imap_message_number ($$$) { ## For imls ## -sub imap_scan_folder ($$@) { - my ($HANDLE, $folder, @ranges) = @_; - my ($uid, $size, $len); +sub imap_scan_folder($$@) { + my($HANDLE, $folder, @ranges) = @_; + my($uid, $size, $len); my $msgset = &imap_range2set($HANDLE, @ranges); return 0 if !$msgset; @@ -857,20 +847,20 @@ sub imap_scan_folder ($$@) { my %ImapHandleCache = (); -sub imap_open_folders ($@) { - my ($create, @folders) = @_; +sub imap_open_folders($@) { + my($create, @folders) = @_; foreach (@folders) { next unless (/^%/); my $acct = imap_folder_acct($_); my $ifld = imap_folder_name($_); - my ($rc, $HANDLE); + my($rc, $HANDLE); unless ($HANDLE = $ImapHandleCache{$acct}) { - my ($dummy, $auth, $user, $host) + my($dummy, $auth, $user, $host) = imap_spec(imap_folder_regname($_)); - my ($pass, $agtfound, $interact) = + my($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); ($rc, $HANDLE) = imap_open($auth, $host, $user, $pass); @@ -898,19 +888,19 @@ sub imap_open_folders ($@) { return 0; } -sub imap_close_folders () { +sub imap_close_folders() { foreach (keys(%ImapHandleCache)) { imap_close($ImapHandleCache{$_}); } %ImapHandleCache = (); } -sub imap_get_handle ($) { +sub imap_get_handle($) { return $ImapHandleCache{imap_folder_acct(shift)}; } -sub imap_get_message ($$) { - my ($src, $range) = @_; +sub imap_get_message($$) { + my($src, $range) = @_; my $HANDLE = imap_get_handle($src); my $msg = imap_range2msgs($HANDLE, ($range)); @@ -919,7 +909,7 @@ sub imap_get_message ($$) { return (); } - my ($rc, $msgref) = imap_get($HANDLE, $msg); + my($rc, $msgref) = imap_get($HANDLE, $msg); if ($rc < 0) { im_warn("can't get msg $_ from source folder.\n"); return (); @@ -927,8 +917,8 @@ sub imap_get_message ($$) { return $msgref; } -sub imap_put_message ($$;$) { - my ($Message, $dsts, $src_path) = @_; +sub imap_put_message($$;$) { + my($Message, $dsts, $src_path) = @_; my $dst; foreach $dst (@$dsts) { @@ -941,10 +931,10 @@ sub imap_put_message ($$;$) { return 0; } -sub imap_put_file ($$$) { - my ($src, $dsts, $src_path) = @_; +sub imap_put_file($$$) { + my($src, $dsts, $src_path) = @_; my @Message; - local (*SRC); + local(*SRC); unless (im_open(\*SRC, "<$src_path")) { im_warn("can't open local message $src_path.\n"); @@ -959,9 +949,9 @@ sub imap_put_file ($$$) { return imap_put_message(\@Message, $dsts, $src_path); } -sub imap_refile ($$$) { - my ($src, $dsts, $msgs) = @_; - my ($HANDLE, $srcacct, $srcset); +sub imap_refile($$$) { + my($src, $dsts, $msgs) = @_; + my($HANDLE, $srcacct, $srcset); my $link_1st; $srcacct = imap_folder_acct($src); @@ -993,8 +983,8 @@ sub imap_refile ($$$) { return 0; } -sub imap_delete_message () { - my ($src, @range) = @_; +sub imap_delete_message() { + my($src, @range) = @_; my $HANDLE = imap_get_handle($src); my $srcset = imap_range2set($HANDLE, @range); @@ -1003,6 +993,49 @@ sub imap_delete_message () { 1; +__END__ + +=head1 NAME + +IM::Imap - IMAP handler + +=head1 SYNOPSIS + + use IM::Imap; + + imap_open(auth, host, user, pass) + return value: + 0: success + -1: failure + +Other subroutines: +imap_select imap_head imap_get imap_put imap_delete +imap_get_msg imap_spec imap_range2set imap_folder_regname imap_scan_folder +imap_open_folders imap_close_folders imap_get_handle imap_get_message +imap_put_message imap_put_file imap_refile imap_delete_message + +=head1 DESCRIPTION + +The I<IM::Imap> module handles IMAP. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + my($rc, $HANDLE) = imap_open($auth, $host, $user, $pass); + if ($rc < 0) { + exit 1; + } + imap_close($HANDLE); + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Iso2022jp.pm b/img/dist/IM/IM/Iso2022jp.pm index 98f5959b..bcb37bfb 100644 --- a/img/dist/IM/IM/Iso2022jp.pm +++ b/img/dist/IM/IM/Iso2022jp.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Iso2022jp.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Iso2022jp.pm version 20021207(IM142)"; package IM::Iso2022jp; require 5.003; @@ -28,24 +28,6 @@ use vars qw(@ISA @EXPORT); header_iso2022jp_conv ); -=head1 NAME - -Iso2022jp - MIME header encoder for ISO-2022-JP character set - -=head1 SYNOPSIS - -use IM/Iso2022jp; - -$encoded_string_for_structured_header = struct_iso2022jp_mimefy(string); - -$encoded_string_for_unstructured_header = line_iso2022jp_mimefy(string); - -$rcode = header_iso2022jp_conv(\@Header, code_conv_flag); - -=head1 DESCRIPTION - -=cut - use vars qw($Jp_Bin $Jp_Qin $Jp_out $Jis_kanji $Jis_roman $C_pascii); @@ -64,16 +46,16 @@ BEGIN { # return value: (lines, err) # lines: converted lines (NULL if error) # -sub struct_iso2022jp_mimefy ($) { +sub struct_iso2022jp_mimefy($) { my $line_in = shift; - my ($c, $groupsyntax); - my ($inquote, $incomment, $addrquote) = (0, 0, 0); - my ($groupcolon, $need_space, $need_encode) = (0, 0, 0); - my ($line_out, $line_work) = ('', ''); - my ($n); + my($c, $groupsyntax); + my($inquote, $incomment, $addrquote) = (0, 0, 0); + my($groupcolon, $need_space, $need_encode) = (0, 0, 0); + my($line_out, $line_work) = ('', ''); + my($n); im_debug("encoding structured: $line_in\n") if (&debug('encode')); while ($line_in ne '') { - if ($line_in =~ /^($Jis_kanji[^\e]+$Jis_roman([ \t]*$Jis_kanji[^\e]+$Jis_roman)*)(.*)/os){ + if ($line_in =~ /^($Jis_kanji[^\e]+$Jis_roman([ \t]*$Jis_kanji[^\e]+$Jis_roman)*)(.*)/os) { $c = $1; $line_in = $3; $need_encode = 1; @@ -238,7 +220,7 @@ sub struct_iso2022jp_mimefy ($) { # &error_exit; return ''; } - if ($line_out =~ /$Jis_kanji[^\e]+$Jis_roman/o){ + if ($line_out =~ /$Jis_kanji[^\e]+$Jis_roman/o) { im_err("invalid iso-2022-jp charset location in structured field: " . "$line_out\n"); # &error_exit; @@ -253,9 +235,9 @@ sub struct_iso2022jp_mimefy ($) { # lines: continuous header lines to be converted # return value: converted lines # -sub line_iso2022jp_mimefy ($) { - my ($line_in) = @_; - my ($line_out, $this_word, $this_space, $this_code, $follow, $n); +sub line_iso2022jp_mimefy($) { + my($line_in) = @_; + my($line_out, $this_word, $this_space, $this_code, $follow, $n); $follow = 0; $this_space = ''; $line_out = ''; @@ -292,7 +274,7 @@ sub line_iso2022jp_mimefy ($) { $line_in = $3; $this_word .= $1; $this_code = 'iso-2022-jp'; - } elsif ($line_in =~ /^($Jis_roman)(.*)/os){ # XXX + } elsif ($line_in =~ /^($Jis_roman)(.*)/os) { # XXX last if ($this_code ne 'us-ascii' && $this_code ne 'iso-2022-jp'); $line_in = $2; @@ -343,10 +325,10 @@ sub line_iso2022jp_mimefy ($) { # struct: true if in structured field # return value: encoded words # -sub word_iso2022jp_mimefy ($$$$) { - my ($size, $word_in, $need_pre_space, $struct) = @_; - my ($word_out) = ''; - my ($word_conv, $n, $word_sub, $word_rest); +sub word_iso2022jp_mimefy($$$$) { + my($size, $word_in, $need_pre_space, $struct) = @_; + my($word_out) = ''; + my($word_conv, $n, $word_sub, $word_rest); if ($main::NoFolding) { if ($main::HdrQEncoding) { @@ -447,10 +429,10 @@ sub word_iso2022jp_mimefy ($$$$) { # 0: success # -1: failure # -sub header_iso2022jp_conv ($$) { - my ($header, $code_conv) = @_; - my ($i, $c); - my ($field_name, $field_value); +sub header_iso2022jp_conv($$) { + my($header, $code_conv) = @_; + my($i, $c); + my($field_name, $field_value); for ($i = 0; $i <= $#$header; $i++) { im_debug("Iso2022jp: converting: $$header[$i]\n") if (&debug('encode')); $c = &code_check($$header[$i]); @@ -501,8 +483,8 @@ sub header_iso2022jp_conv ($$) { # space: separatig space # return value: a concatinated header string # -sub hdr_cat ($$$) { - my ($str1, $str2, $space) = @_; +sub hdr_cat($$$) { + my($str1, $str2, $space) = @_; if ($str1 eq '' || $str1 =~ /\n[\t ]+$/) { return "$str1$space$str2"; @@ -521,6 +503,34 @@ sub hdr_cat ($$$) { 1; +__END__ + +=head1 NAME + +IM::Iso2022jp - MIME header encoder for ISO-2022-JP + +=head1 SYNOPSIS + + use IM::Iso2022jp; + + $encoded_string_for_structured_header = struct_iso2022jp_mimefy(string); + $encoded_string_for_unstructured_header = line_iso2022jp_mimefy(string); + $rcode = header_iso2022jp_conv(\@Header, code_conv_flag); + +=head1 DESCRIPTION + +The I<IM::Iso2022jp> module is MIME header encoder for ISO-2022-JP. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Japanese.pm b/img/dist/IM/IM/Japanese.pm index 08948d60..f0e1e1bb 100644 --- a/img/dist/IM/IM/Japanese.pm +++ b/img/dist/IM/IM/Japanese.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Japanese.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Japanese.pm version 20021207(IM142)"; package IM::Japanese; require 5.003; @@ -23,22 +23,6 @@ use vars qw(@ISA @EXPORT); convert_iso2022jp_body conv_iso2022jp conv_euc_from_jis conv_euc_from_sjis); -=head1 NAME - -Japanese - IM Japanese handler - -=head1 SYNOPSIS - - use IM::Japanese; - $code = code_check($line, $use_hankaku_kana); - $code = code_check_body($content); - convert_iso2022jp_body($content, $code); - $converted = conv_iso2022jp($line, $code); - -=head1 DESCRIPTION - -=cut - use vars qw($C_jis $C_jis_roman $C_sjis $C_sjis_kana $C_euc $C_euc_kana $C_SorE $C_ascii $C_pascii $C_tascii $C_sascii $C_8bit @@ -75,9 +59,9 @@ BEGIN { # sjis # sORe # -sub code_check ($;$) { - my ($line, $no_hankaku_kana) = @_; - my ($sjis, $euc); +sub code_check($;$) { + my($line, $no_hankaku_kana) = @_; + my($sjis, $euc); if ($line =~ /^$C_ascii*$/o) { return 'ascii'; @@ -114,9 +98,9 @@ sub code_check ($;$) { # EUC # SJIS # -sub code_check_body ($) { +sub code_check_body($) { my $content = shift; - my (%count) = (); + my(%count) = (); $count{'ascii'} = 0; # for debug print $count{'8bit'} = 0; @@ -171,8 +155,8 @@ sub code_check_body ($) { # code: input kanji code # return value: none # -sub convert_iso2022jp_body ($$) { - my ($content, $code) = @_; +sub convert_iso2022jp_body($$) { + my($content, $code) = @_; my $i; for ($i = 0; $i <= $#$content; $i++) { @@ -187,8 +171,8 @@ sub convert_iso2022jp_body ($$) { # code: input kanji code # return value: converted line # -sub conv_iso2022jp ($;$) { - my ($line, $code) = @_; +sub conv_iso2022jp($;$) { + my($line, $code) = @_; im_debug("conv_iso2022jp: $line\n") if (&debug('japanese')); @@ -221,19 +205,19 @@ sub conv_iso2022jp ($;$) { # line: a line of string to be converted # return value: converted line # -sub conv_from_sjis ($) { +sub conv_from_sjis($) { my $line = shift; $line =~ s/((?:$C_sjis|$C_sjis_kana)+)/sjis2jis($1)/geo; return $line; } -sub sjis2jis ($) { +sub sjis2jis($) { my $line = shift; $line =~ s/((?:$C_sjis)+|(?:$C_sjis_kana)+)/s2j($1)/geo; return "$line$E_asc"; } -sub s2e ($) { +sub s2e($) { my $code = shift; - my ($c1, $c2) = unpack('CC', $code); + my($c1, $c2) = unpack('CC', $code); if (0xa1 <= $c1 && $c1 <= 0xdf) { $c2 = $c1; $c1 = 0x8e; @@ -246,7 +230,7 @@ sub s2e ($) { } return pack('CC', $c1, $c2); } -sub s2j ($) { +sub s2j($) { my $cur = shift; if ($cur =~ /^$C_sjis_kana/o) { $cur =~ tr/\xa1-\xdf/\x21-\x5f/; @@ -264,17 +248,17 @@ sub s2j ($) { # line: a line of string to be converted # return value: converted line # -sub conv_from_euc ($) { +sub conv_from_euc($) { my $line = shift; $line =~ s/((?:$C_euc|$C_euc_kana)+)/euc2jis($1)/geo; return $line; } -sub euc2jis ($) { +sub euc2jis($) { my $line = shift; $line =~ s/((?:$C_euc)+|(?:$C_euc_kana)+)/e2j($1)/geo; return "$line$E_asc"; } -sub e2j ($) { +sub e2j($) { my $cur = shift; $cur =~ tr/\xa1-\xfe/\x21-\x7e/; if ($cur =~ tr/\x8e//d) { @@ -291,7 +275,7 @@ sub e2j ($) { # return value: converted line # -sub conv_euc_from_sjis ($) { +sub conv_euc_from_sjis($) { my $line = shift; $line =~ s/($C_sjis|$C_sjis_kana)/s2e($1)/geo; return $line; @@ -304,14 +288,14 @@ sub conv_euc_from_sjis ($) { # return value: converted line # -sub conv_euc_from_jis ($) { +sub conv_euc_from_jis($) { my $line = shift; $line =~ s/$C_jis/j2e($1,$2)/geo; $line =~ s/\e\$C_jis_roman/$2/geo; return $line; } -sub j2e ($$) { +sub j2e($$) { my $esc = shift; my $line = shift; if ($esc =~ /\e\$[\@B]/) { @@ -322,6 +306,36 @@ sub j2e ($$) { 1; +__END__ + +=head1 NAME + +IM::Japanese - Japanese message handler + +=head1 SYNOPSIS + + use IM::Japanese; + + $code = code_check($line, $use_hankaku_kana); + $code = code_check_body($content); + convert_iso2022jp_body($content, $code); + $converted = conv_iso2022jp($line, $code); + +=head1 DESCRIPTION + +The I<IM::Japanese> module handles Japanese message encoded with +ISO-2022-JP, EUC-JP, Shift_JIS, or US-ASCII. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/LocalMbox.pm b/img/dist/IM/IM/LocalMbox.pm index 8a38fde1..1c27bbee 100644 --- a/img/dist/IM/IM/LocalMbox.pm +++ b/img/dist/IM/IM/LocalMbox.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::LocalMbox.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::LocalMbox.pm version 20021207(IM142)"; package IM::LocalMbox; require 5.003; @@ -25,22 +25,6 @@ use vars qw(@ISA @EXPORT $getchk_hook); @ISA = qw(Exporter); @EXPORT = qw(local_get_msg); -=head1 NAME - -LocalMbox - local mailbox managing package - -=head1 SYNOPSIS - -$num_msgs = &local_get_msg(source_mailbox, destination_folder, access_mode); - -=head1 DESCRIPTION - -$mbox = 'local:/var/mail/motonori'; -$folder = '+inbox' -$num_msgs = &local_get_msg($mbox, $folder, 'get'); - -=cut - use vars qw($locked_by_file $locked_by_flock); ################################# # local mailbox access routines # @@ -51,10 +35,10 @@ use vars qw($locked_by_file $locked_by_flock); # local_get_msg(src, dst, how) # check, from, get # -sub local_get_msg ($$$$$) { - my ($src, $dst, $how, $lock_type, $noscan) = @_; - my ($need_lock, $qmail_ok, $msgs, $l, $file, $p); - my (@MailDrops); +sub local_get_msg($$$$$) { + my($src, $dst, $how, $lock_type, $noscan) = @_; + my($need_lock, $qmail_ok, $msgs, $l, $file, $p); + my(@MailDrops); if ($how eq 'get') { $need_lock = 1; @@ -89,7 +73,7 @@ sub local_get_msg ($$$$$) { push(@MailDrops, $ENV{'MAIL'}) if ($ENV{'MAIL'}); push(@MailDrops, "$home/Maildir"); foreach $p (@MailDrops) { - if (( -d $p && -d "$p/new" && -d "$p/cur") || -f $p ) { + if ((-d $p && -d "$p/new" && -d "$p/cur") || -f $p) { $mbox = $p; last; } @@ -104,7 +88,7 @@ sub local_get_msg ($$$$$) { ); unshift(@MailDrops, "$home/Mailbox") if ($qmail_ok); foreach $p (@MailDrops) { - if ( -f $p ) { + if (-f $p) { $mbox = $p; last; } @@ -221,7 +205,7 @@ sub local_get_msg ($$$$$) { } } - truncate (SAVE, tell(SAVE)); + truncate(SAVE, tell(SAVE)); unlink($tmpmbox); } else { if (($msgs = process_mbox($mbox, $dst, $how, '', $noscan)) < 0) { @@ -246,8 +230,8 @@ sub local_get_msg ($$$$$) { } } -sub local_copymbox ($$) { - my ($src, $dst) = @_; +sub local_copymbox($$) { + my($src, $dst) = @_; im_debug("copy from $src to $dst\n") if (&debug('local')); unless (im_open(\*SRC, "<$src")) { @@ -274,15 +258,15 @@ sub local_copymbox ($$) { return -1; } } - truncate (DST, -s SRC); - close (DST); - close (SRC); + truncate(DST, -s SRC); + close(DST); + close(SRC); return 0; } -sub process_maildir ($$$$) { - my ($maildir, $dst, $how, $noscan) = @_; - my ($msgs, $f, $dir); +sub process_maildir($$$$) { + my($maildir, $dst, $how, $noscan) = @_; + my($msgs, $f, $dir); unless (-d "$maildir/new" && -r "$maildir/new" && -x "$maildir/new" && -d "$maildir/cur" && -r "$maildir/cur" && -x "$maildir/cur") { @@ -317,10 +301,10 @@ sub process_maildir ($$$$) { return $msgs; } -sub process_file ($$$$) { - my ($mbox, $dst, $how, $noscan) = @_; - my ($format, $msgs, $rp, $length, $inheader, @Message); - local (*MBOX); +sub process_file($$$$) { + my($mbox, $dst, $how, $noscan) = @_; + my($format, $msgs, $rp, $length, $inheader, @Message); + local(*MBOX); im_notice("opening MBOX ($mbox)\n"); unless (im_open(\*MBOX, "<$mbox")) { @@ -331,8 +315,9 @@ sub process_file ($$$$) { push (@Message, $_); } if ($getchk_hook ne '') { - my $head = lcl_store_header(\@Message); - unless (eval { &getchk_sub($head); }) { + my %head; + lcl_store_header(\%head, \@Message); + unless (eval { &getchk_sub(\%head); }) { close(MBOX); return 1 } @@ -348,11 +333,11 @@ sub process_file ($$$$) { return 0; } -sub process_mbox ($$$$$) { - my ($mbox, $dst, $how, $save, $noscan) = @_; - my ($format, $msgs, $length, $inheader, @Message); - local (*MBOX); - my ($first_line, $FIRST_LINE); +sub process_mbox($$$$$) { + my($mbox, $dst, $how, $save, $noscan) = @_; + my($format, $msgs, $length, $inheader, @Message); + local(*MBOX); + my($first_line, $FIRST_LINE); im_info("Getting new messages from local mailbox into $dst....\n") if ($how eq 'get'); @@ -416,7 +401,7 @@ sub process_mbox ($$$$$) { && /^From / && $Message[$#Message] eq "\n") { chomp($first_line = $_); last; - } elsif ($format eq 'RMAIL' && /^\x1f/ ) { + } elsif ($format eq 'RMAIL' && /^\x1f/) { chomp($first_line = <MBOX>); last; } elsif ($inheader) { @@ -424,7 +409,7 @@ sub process_mbox ($$$$$) { print "$_" if (/^From:/i); } # XXX continuous line processing needed - push (@Message, $_) + push(@Message, $_) unless (/^Return-Path:/i && $main::opt_rpath eq 'replace'); # for Solaris 2.x or ... # XXX option @@ -433,13 +418,13 @@ sub process_mbox ($$$$$) { } $inheader = 0 if (/^\n$/); } else { - push (@Message, $_); + push(@Message, $_); $length -= length($_) if ($length > 0); } } if ($Message[$#Message] eq "\n") { - pop (@Message); + pop(@Message); } if ($getchk_hook) { @@ -475,8 +460,8 @@ sub process_mbox ($$$$$) { return $msgs; } -sub save_message ($$$$) { - my ($msg, $save, $mode, $fline) = @_; +sub save_message($$$$) { + my($msg, $save, $mode, $fline) = @_; im_debug("saving to $save\n") if (&debug('local')); if ($mode eq 'UNIX') { @@ -527,7 +512,7 @@ sub save_message ($$$$) { return 0; } -sub local_empty ($) { +sub local_empty($) { my $mbox = shift; unless (truncate($mbox, 0)) { unless (im_open(\*MBOX, ">$mbox")) { @@ -544,15 +529,15 @@ sub LOCK_EX { 2 } sub LOCK_NB { 4 } sub LOCK_UN { 8 } -sub local_lockmbox ($$) { - my ($base, $type) = @_; +sub local_lockmbox($$) { + my($base, $type) = @_; my $retry = 0; im_warn("creating lock file with uid=$> gid=$)\n") if (&debug('local')); $locked_by_file = 0; $locked_by_flock = 0; if ($type =~ /file/) { -# while (! sysopen(LOCK, "$base.lock", O_RDWR()|O_CREAT()|O_EXCL())) { +# while (!sysopen(LOCK, "$base.lock", O_RDWR()|O_CREAT()|O_EXCL())) { # if ($retry >= 10) { # im_warn("can't create $base.lock: $!\n"); # return -1; @@ -589,7 +574,7 @@ sub local_lockmbox ($$) { im_err "can't open $base :$!\n"; return -1; } - if (! &win95p ){ + if (! &win95p) { unless (flock (LOCK_FH, LOCK_EX|LOCK_NB)) { im_warn "can't flock $base: $!\n"; return -1; @@ -600,7 +585,7 @@ sub local_lockmbox ($$) { return 0; } -sub local_unlockmbox ($) { +sub local_unlockmbox($) { my $base = shift; my $rcode = 0; im_debug("removing lock file with uid=$> gid=$)\n") if (&debug('local')); @@ -612,7 +597,7 @@ sub local_unlockmbox ($) { $locked_by_file = 0; } if ($locked_by_flock) { - if (! &win95p ){ + if (! &win95p) { flock(LOCK_FH, LOCK_UN); } $locked_by_flock = 0; @@ -620,9 +605,9 @@ sub local_unlockmbox ($) { return $rcode; } -sub lcl_store_header ($$) { - my ($href, $msg) = @_; - my ($line); +sub lcl_store_header($$) { + my($href, $msg) = @_; + my($line); foreach (@$msg) { my $l = $_; @@ -640,8 +625,8 @@ sub lcl_store_header ($$) { lcl_set_line($href, $line); } -sub lcl_set_line ($$) { - my ($href, $line) = @_; +sub lcl_set_line($$) { + my($href, $line) = @_; return unless ($line =~ /^([^:]*):\s*(.*)$/); my $label = lc($1); @@ -660,6 +645,39 @@ sub lcl_set_line ($$) { 1; +__END__ + +=head1 NAME + +IM::LocalMbox - local mailbox managing + +=head1 SYNOPSIS + + use IM::LocalMbox; + + $num_msgs = &local_get_msg(source_mailbox, destination_folder, access_mode); + +=head1 DESCRIPTION + +The I<IM::LocalMbox> module handles local mailbox. +MH folder, MMDF file, mbox, and Maildir are supported. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + $mbox = 'local:/var/mail/motonori'; + $folder = '+inbox' + $num_msgs = &local_get_msg($mbox, $folder, 'get'); + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Log.pm b/img/dist/IM/IM/Log.pm index 0bb84e07..256fe9da 100644 --- a/img/dist/IM/IM/Log.pm +++ b/img/dist/IM/IM/Log.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Log.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Log.pm version 20021207(IM142)"; package IM::Log; require 5.003; @@ -23,16 +23,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(log_action); -=head1 NAME - -Log - IM log_action - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw($initialized); ##### WRITE DISPATCHING ACTION HISTORY ##### # @@ -43,9 +33,9 @@ use vars qw($initialized); # to: list of recipients # return value: none # -sub log_action ($$$$;@) { - my ($proto, $server, $to, $stat, @resp) = @_; -# my ($proto, $server, $id, $to, $stat, @resp) = @_; +sub log_action($$$$;@) { + my($proto, $server, $to, $stat, @resp) = @_; +# my($proto, $server, $id, $to, $stat, @resp) = @_; return if ($main::Log_file eq '' && !$main::opt_syslog); @@ -73,7 +63,7 @@ sub log_action ($$$$;@) { } } - my ($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year) + my($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year) = localtime(time); my $msg = ''; $msg = sprintf "%d/%02d/%02d %02d:%02d:%02d ", @@ -119,6 +109,33 @@ sub log_action ($$$$;@) { 1; +__END__ + +=head1 NAME + +IM::Log - IM log handler + +=head1 SYNOPSIS + + use IM::Log; + + $main::Log_file = "putlog"; + log_action($proto, $server, $to, $stat, @resp); + +=head1 DESCRIPTION + +The I<IM::Log> module handles log file of IM. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/MD5.pm b/img/dist/IM/IM/MD5.pm index ba9fe4f7..3c995b28 100644 --- a/img/dist/IM/IM/MD5.pm +++ b/img/dist/IM/IM/MD5.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::MD5.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::MD5.pm version 20021207(IM142)"; package IM::MD5; require 5.003; @@ -21,30 +21,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(md5_str); -=head1 NAME - -MD5 - The MD5 Message-Digesting package - -=head1 SYNOPSIS - - use IM::MD5; - - $digest = &md5_str($text); - -=head1 DESCRIPTION - - &md5_str("") returns d41d8cd98f00b204e9800998ecf8427e. - &md5_str("a") returns 0cc175b9c0f1b6a831c399e269772661. - &md5_str("abc") returns 900150983cd24fb0d6963f7d28e17f72. - &md5_str("message digest") returns f96b697d7cb7938d525a2f31aaf161d0. - &md5_str("abcdefghijklmnopqrstuvwxyz") returns c3fcd3d76192e4007dfb496cca67e13b. - &md5_str("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") returns d174ab98d277d9f5a5611c2c9f419d9f. - &md5_str("12345678901234567890123456789012345678901234567890123456789012345678901234567890") returns 57edf4a22be3c955ac49da2e2107b67a. - - % perl -MIM::MD5 -e 'IM::MD5::MD5_TEST()' - -=cut - use vars qw($MD5_S11 $MD5_S12 $MD5_S13 $MD5_S14 $MD5_S21 $MD5_S22 $MD5_S23 $MD5_S24 $MD5_S31 $MD5_S32 $MD5_S33 $MD5_S34 @@ -54,11 +30,11 @@ use vars qw($MD5_S11 $MD5_S12 $MD5_S13 $MD5_S14 # MD5 routines # ################ -sub md5_str ($) { +sub md5_str($) { my($str) = @_; my($len); - my (@context_count, @context_state, @context_buffer); - my (@digest); + my(@context_count, @context_state, @context_buffer); + my(@digest); $len = length($str); my @string = unpack('C*', $str); @@ -69,41 +45,10 @@ sub md5_str ($) { &MD5Final(\@digest, \@context_count, \@context_state, \@context_buffer); return unpack('H*', pack('C*', @digest)); - } +} ############################################################################### -### -### md5.pl -- MD5 message-digest algorithm converted to Perl4 from C version -### -### Copyright (C) 1996 by NAKAMURA, Motonori <motonori@econ.kyoto-u.ac.jp>. -### All rights reserved. -### [August 16, 1996] - -# MD5C.C - RSA Data Security, Inc., MD5 message-digest algorithm - -# Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All -# rights reserved. - -# License to copy and use this software is granted provided that it -# is identified as the "RSA Data Security, Inc. MD5 Message-Digest -# Algorithm" in all material mentioning or referencing this software -# or this function. - -# License is also granted to make and use derivative works provided -# that such works are identified as "derived from the RSA Data -# Security, Inc. MD5 Message-Digest Algorithm" in all material -# mentioning or referencing the derived work. - -# RSA Data Security, Inc. makes no representations concerning either -# the merchantability of this software or the suitability of this -# software for any particular purpose. It is provided "as is" -# without express or implied warranty of any kind. - -# These notices must be retained in any copies of any part of this -# documentation and/or software. - - # F, G, H and I are basic MD5 functions. sub MD5_F {my($x, $y, $z) = @_; ((($x) & ($y)) | (&MD5_trunc(~$x) & ($z))); } @@ -130,19 +75,19 @@ sub MD5_FF { $a = &MD5_trunc($a + &MD5_F($b, $c, $d) + $x + $ac); $a = &MD5_ROTATE_LEFT($a, $s); $a = &MD5_trunc($a + $b); - } +} sub MD5_GG { my($a, $b, $c, $d, $x, $s, $ac) = @_; $a = &MD5_trunc($a + &MD5_G($b, $c, $d) + $x + $ac); $a = &MD5_ROTATE_LEFT($a, $s); $a = &MD5_trunc($a + $b); - } +} sub MD5_HH { my($a, $b, $c, $d, $x, $s, $ac) = @_; $a = &MD5_trunc($a + &MD5_H($b, $c, $d) + $x + $ac); $a = &MD5_ROTATE_LEFT($a, $s); $a = &MD5_trunc($a + $b); - } +} sub MD5_II { my($a, $b, $c, $d, $x, $s, $ac) = @_; $a = &MD5_trunc($a + &MD5_I($b, $c, $d) + $x + $ac); @@ -168,8 +113,8 @@ sub MD5_trunc { # MD5 initialization. Begins an MD5 operation, writing a new context. -sub MD5Init ($$$) { - my ($context_count, $context_state, $context_buffer) = @_; +sub MD5Init($$$) { + my($context_count, $context_state, $context_buffer) = @_; # Constants for MD5Transform routine. $MD5_S11 = 7; @@ -208,10 +153,10 @@ sub MD5Init ($$$) { # operation, processing another message block, and updating the # context. -sub MD5Update ($$$$$) { - my ($context_count, $context_state, $context_buffer, +sub MD5Update($$$$$) { + my($context_count, $context_state, $context_buffer, $input, $inputLen) = @_; - my (@arg1, @arg2); + my(@arg1, @arg2); my($i, $index, $partLen); # Compute number of bytes mod 64 @@ -255,9 +200,9 @@ sub MD5Update ($$$$$) { # MD5 finalization. Ends an MD5 message-digest operation, writing the # the message digest and zeroizing the context. -sub MD5Final ($$$$) { - my ($digest, $context_count, $context_state, $context_buffer) = @_; - my (@bits); +sub MD5Final($$$$) { + my($digest, $context_count, $context_state, $context_buffer) = @_; + my(@bits); my($index, $padLen); @bits = ((0) x 8); @@ -284,13 +229,13 @@ sub MD5Final ($$$$) { # MD5 basic transformation. Transforms state based on block. -sub MD5Transform ($$) { - my ($state, $block) = @_; +sub MD5Transform($$) { + my($state, $block) = @_; my($a) = $state->[0]; my($b) = $state->[1]; my($c) = $state->[2]; my($d) = $state->[3]; - my (@x); + my(@x); &MD5_Decode(\@x, $block, 64); @@ -378,8 +323,8 @@ sub MD5Transform ($$) { # Encodes input (UINT4) into output (unsigned char). Assumes len is # a multiple of 4. -sub MD5_Encode ($$$) { - my ($output, $input, $len) = @_; +sub MD5_Encode($$$) { + my($output, $input, $len) = @_; my($i, $j); for ($i = 0, $j = 0; $j < $len; $i++, $j += 4) { @@ -393,8 +338,8 @@ sub MD5_Encode ($$$) { # Decodes input (unsigned char) into output (UINT4). Assumes len is # a multiple of 4. -sub MD5_Decode ($$$) { - my ($output, $input, my $len) = @_; +sub MD5_Decode($$$) { + my($output, $input, my $len) = @_; my($i, $j); for ($i = 0, $j = 0; $j < $len; $i++, $j += 4) { @@ -405,8 +350,8 @@ sub MD5_Decode ($$$) { # Note: Replace "for loop" with standard memcpy if possible. -sub MD5_memcpy ($$$) { - my ($output, $input, $len) = @_; +sub MD5_memcpy($$$) { + my($output, $input, $len) = @_; my($i); for ($i = 0; $i < $len; $i++) { @@ -416,8 +361,8 @@ sub MD5_memcpy ($$$) { # Note: Replace "for loop" with standard memset if possible. -sub MD5_memset ($$$) { - my ($output, $value, $len) = @_; +sub MD5_memset($$$) { + my($output, $value, $len) = @_; my($i); for ($i = 0; $i < $len; $i++) { @@ -430,8 +375,8 @@ use SelfLoader; __DATA__ sub MD5_CHECK { - my ($str, $should) = @_; - my ($r) = &md5_str($str); + my($str, $should) = @_; + my($r) = &md5_str($str); printf "MD5 (\"%s\") = %s", $str, $r; if ($r eq $should) { @@ -442,7 +387,7 @@ sub MD5_CHECK { } sub MD5_TEST { - my (%v); + my(%v); $v{""} = "d41d8cd98f00b204e9800998ecf8427e"; $v{"a"} = "0cc175b9c0f1b6a831c399e269772661"; $v{"abc"} = "900150983cd24fb0d6963f7d28e17f72"; @@ -457,6 +402,78 @@ sub MD5_TEST { } } +1; + +__END__ + +=head1 NAME + +IM::MD5 - MD5 message-digesting + +=head1 SYNOPSIS + + use IM::MD5; + + $digest = &md5_str($text); + +=head1 DESCRIPTION + +The I<IM::MD5> module handles MD5 message-digest algorithm. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + &md5_str("") returns d41d8cd98f00b204e9800998ecf8427e. + &md5_str("a") returns 0cc175b9c0f1b6a831c399e269772661. + &md5_str("abc") returns 900150983cd24fb0d6963f7d28e17f72. + &md5_str("message digest") returns f96b697d7cb7938d525a2f31aaf161d0. + &md5_str("abcdefghijklmnopqrstuvwxyz") returns c3fcd3d76192e4007dfb496cca67e13b. + &md5_str("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") returns d174ab98d277d9f5a5611c2c9f419d9f. + &md5_str("12345678901234567890123456789012345678901234567890123456789012345678901234567890") returns 57edf4a22be3c955ac49da2e2107b67a. + + % perl -MIM::MD5 -e 'IM::MD5::MD5_TEST()' + +=head1 COPYRIGHT + +This modules is derived from md5.pl copyrighted by NAKAMURA, Motonori +<motonori@econ.kyoto-u.ac.jp>. It is converted to Perl4 from C version +derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm. + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + +### md5.pl -- MD5 message-digest algorithm converted to Perl4 from C version +### +### Copyright (C) 1996 by NAKAMURA, Motonori <motonori@econ.kyoto-u.ac.jp>. +### All rights reserved. +### [August 16, 1996] +### +### MD5C.C - RSA Data Security, Inc., MD5 message-digest algorithm +### +### Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All +### rights reserved. +### +### License to copy and use this software is granted provided that it +### is identified as the "RSA Data Security, Inc. MD5 Message-Digest +### Algorithm" in all material mentioning or referencing this software +### or this function. +### +### License is also granted to make and use derivative works provided +### that such works are identified as "derived from the RSA Data +### Security, Inc. MD5 Message-Digest Algorithm" in all material +### mentioning or referencing the derived work. +### +### RSA Data Security, Inc. makes no representations concerning either +### the merchantability of this software or the suitability of this +### software for any particular purpose. It is provided "as is" +### without express or implied warranty of any kind. +### +### These notices must be retained in any copies of any part of this +### documentation and/or software. ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. diff --git a/img/dist/IM/IM/Message.pm b/img/dist/IM/IM/Message.pm index c96afaa4..04d8e4e4 100644 --- a/img/dist/IM/IM/Message.pm +++ b/img/dist/IM/IM/Message.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Message.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Message.pm version 20021207(IM142)"; package IM::Message; require 5.003; @@ -48,16 +48,6 @@ use vars qw(@ISA @EXPORT); sort_header ); -=head1 NAME - -Message - IM Message - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw($First_body_line $First_part_mid $bcc_mid $crlf_char @Week_str @Month_str $Cur_time @@ -65,7 +55,7 @@ use vars qw($First_body_line $First_part_mid @Week_str = qw(Sun Mon Tue Wed Thu Fri Sat); @Month_str = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); -sub cur_time ($) { +sub cur_time($) { my $part = shift; return $Cur_time if ($Cur_time && $part == 0); return $Cur_time = time; @@ -80,10 +70,10 @@ sub cur_time ($) { # 0: success # -1: failure # -sub read_header (*$$) { +sub read_header(*$$) { local *CHAN = shift; - my ($Header, $dist_append) = @_; - my ($inheader, $line) = (1, ''); + my($Header, $dist_append) = @_; + my($inheader, $line) = (1, ''); $First_body_line = ''; local $_ = <CHAN>; @@ -134,9 +124,9 @@ sub read_header (*$$) { # -1: failed # 0: success # -sub rewrite_header ($) { +sub rewrite_header($) { my $Header = shift; - my ($i, $val); + my($i, $val); local $_; my $e = $#$Header; # do not evaluate in the loop @@ -173,9 +163,9 @@ sub rewrite_header ($) { # append_default: append default domain name for local names if true # return value: rewritten addresses (NULL if error) # -sub rewrite_addr_list ($$$;$) { - my ($Header, $sender_flag, $addr_list, $def_append) = @_; - my ($line, $ret, $addr, $a, $b, $err); +sub rewrite_addr_list($$$;$) { + my($Header, $sender_flag, $addr_list, $def_append) = @_; + my($line, $ret, $addr, $a, $b, $err); $addr_list =~ s/^\s+//; $addr_list =~ s/\s+$//; @@ -224,7 +214,7 @@ sub rewrite_addr_list ($$$;$) { $b = "$a\@$main::Default_to_domain_name"; $addr = &replace_addr($addr, $a, $b); } - } elsif ($b = hosts_completion($a,$main::Cmpl_with_gethostbyname)){ + } elsif ($b = hosts_completion($a,$main::Cmpl_with_gethostbyname)) { $addr = &replace_addr($addr, $a, $b); } } @@ -241,7 +231,7 @@ sub rewrite_addr_list ($$$;$) { # rewrite_resend_header() # return value: none # -sub rewrite_resend_header ($) { +sub rewrite_resend_header($) { my $Header = shift; my $i; @@ -262,10 +252,10 @@ sub rewrite_resend_header ($) { # 0: success # -1: failure # -sub put_header (*$$$) { +sub put_header(*$$$) { local *CHAN = shift; - my ($Header, $proto, $sel) = @_; - my ($line, $del, $s); + my($Header, $proto, $sel) = @_; + my($line, $del, $s); my $crlf = &crlf; im_debug("entering put_header ($sel)\n") @@ -332,9 +322,9 @@ sub put_header (*$$$) { # term_dot: terminating dot protocol is used if true # return value: none # -sub read_body (*$$$) { +sub read_body(*$$$) { local *CHAN = shift; - my ($Body, $hidden_dot, $term_dot) = @_; + my($Body, $hidden_dot, $term_dot) = @_; local $_; @$Body = (); @@ -364,9 +354,9 @@ sub read_body (*$$$) { # content: pointer to body content line list # return value: none # -sub body_qp_encode ($) { +sub body_qp_encode($) { my $Body = shift; - my ($i, $line, $pos); + my($i, $line, $pos); for ($i = 0; $i <= $#$Body; $i++) { $line = $$Body[$i]; @@ -396,10 +386,10 @@ sub body_qp_encode ($) { # content: pointer to body content line list # return value: none # -sub body_base64_encode ($) { +sub body_base64_encode($) { my $Body = shift; my $line = ''; - my ($i, $tmp, @Body_tmp); + my($i, $tmp, @Body_tmp); require IM::EncDec && import IM::EncDec qw(b_encode_string); @@ -429,10 +419,10 @@ sub body_base64_encode ($) { # 0: success # -1: failure # -sub put_body (*$$$) { +sub put_body(*$$$) { local *CHAN = shift; - my ($Body, $hidden_dot, $part) = @_; - my ($start, $end, $i, $line); + my($Body, $hidden_dot, $part) = @_; + my($start, $end, $i, $line); my $crlf= &crlf; if ($part == 0) { @@ -471,9 +461,9 @@ sub put_body (*$$$) { # 0: success # -1: failure # -sub put_mimed_bcc (*$$$$$$) { +sub put_mimed_bcc(*$$$$$$) { local *CHAN = shift; - my ($Header, $Body, $proto, $hidden_dot, $part, $total) = @_; + my($Header, $Body, $proto, $hidden_dot, $part, $total) = @_; my $subj; my $crlf = &crlf; @@ -538,9 +528,9 @@ sub put_mimed_bcc (*$$$$$$) { # 0: success # -1: failure # -sub put_mimed_partial (*$$$$$$) { +sub put_mimed_partial(*$$$$$$) { local *CHAN = shift; - my ($Header, $Body, $proto, $hidden_dot, $part, $total) = @_; + my($Header, $Body, $proto, $hidden_dot, $part, $total) = @_; my $crlf = &crlf; return -1 if (&put_header(\*CHAN, $Header, $proto, 'partial:ext') < 0); @@ -583,10 +573,10 @@ sub put_mimed_partial (*$$$$$$) { # 0: success # -1: failure # -sub put_mimed_error_notify (*$$$$$$$$;$) { +sub put_mimed_error_notify(*$$$$$$$$;$) { local *CHAN = shift; - my ($Header, $Body, $Recp, $Stat, $proto, $server, - $hidden_dot, $session_log, $part) = @_; # XXX: $part missing? + my($Header, $Body, $Recp, $Stat, $proto, $server, + $hidden_dot, $session_log, $part) = @_; # XXX: $part missing? my $subj; my $crlf = &crlf; my $boundary; @@ -639,7 +629,7 @@ sub put_mimed_error_notify (*$$$$$$$$;$) { # host information my $myhostname = hostname(); unless ($myhostname =~ /\./) { - my ($h) = gethostbyname($myhostname); + my($h) = gethostbyname($myhostname); $myhostname = $h if ($h); } @@ -684,9 +674,9 @@ sub put_mimed_error_notify (*$$$$$$$$;$) { # body: reference to a message body array # return value: size of whole message # -sub message_size ($$$) { - my ($Header, $Body, $part) = @_; - my ($start, $end, $i, $size); +sub message_size($$$) { + my($Header, $Body, $part) = @_; + my($start, $end, $i, $size); if ($part == 0) { $start = 0; @@ -706,11 +696,11 @@ sub message_size ($$$) { return $size; } -sub set_crlf ($) { +sub set_crlf($) { $crlf_char = shift; } -sub crlf () { +sub crlf() { $crlf_char; } @@ -720,14 +710,14 @@ sub crlf () { # part: part number of partial messages (for reuse) # return value: a unique message-id string # -sub gen_message_id ($) { +sub gen_message_id($) { my $part = shift; return $Mid_hist{$part} if ($part > 0 && $Mid_hist{$part}); - my ($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year) + my($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year) = localtime(&cur_time($part)); - my ($mid_time) = sprintf("%d%02d%02d%02d%02d%02d", + my($mid_time) = sprintf("%d%02d%02d%02d%02d%02d", $tm_year+1900, $tm_mon+1, $tm_mday, $tm_hour, $tm_min, $tm_sec); - my ($mid_rnd) = sprintf("%c", 0x41 + rand(26)); + my($mid_rnd) = sprintf("%c", 0x41 + rand(26)); if ($Prev_mid_time eq $mid_time) { while ($mid_rnd =~ /[$Mid_rnd_hist]/) { $mid_rnd = sprintf("%c", 0x41 + rand(26)); @@ -746,7 +736,7 @@ sub gen_message_id ($) { } else { $mid_user = $main::Login; } - my ($mid) + my($mid) = "<$mid_time$mid_rnd.$mid_user\@$main::Message_id_domain_name>"; $Mid_hist{$part} = $mid if ($part > 0); return $mid; @@ -761,10 +751,10 @@ sub gen_message_id ($) { # 2 = "WWW MMM DD HH:MM:SS YYYY" (mainly for UNIX From) # return value: date string generated with current time # -sub gen_date ($) { +sub gen_date($) { my $format = shift; - my ($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year, - $tm_wk, $tm_yday, $tm_isdst, $tm_tz); + my($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year, + $tm_wk, $tm_yday, $tm_isdst, $tm_tz); if ($main::NewsGMTdate && $main::News_flag) { ($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year, $tm_wk, $tm_yday) = gmtime(&cur_time(0)); @@ -787,8 +777,8 @@ sub gen_date ($) { } } } else { - my ($gm_sec, $gm_min, $gm_hour, $gm_mday, $gm_mon, - $gm_year, $gm_wk, $gm_yday) = gmtime(&cur_time(0)); + my($gm_sec, $gm_min, $gm_hour, $gm_mday, $gm_mon, + $gm_year, $gm_wk, $gm_yday) = gmtime(&cur_time(0)); $off = ($tm_hour - $gm_hour) * 60 + $tm_min - $gm_min; if ($tm_year < $gm_year) { $off -= 24 * 60; @@ -832,8 +822,8 @@ sub gen_date ($) { # field: field name of which value needed # return value: value for specified field OR null # -sub header_value ($$) { - my ($Header, $field_name) = @_; +sub header_value($$) { + my($Header, $field_name) = @_; my $val; local $_; @@ -855,8 +845,8 @@ sub header_value ($$) { # field_value: field value to be entered with # return value: none # -sub add_header ($$$$) { - my ($Header, $replace_flag, $field_name, $field_value) = @_; +sub add_header($$$$) { + my($Header, $replace_flag, $field_name, $field_value) = @_; $field_value .= "\n" if ($field_value !~ /\n$/); im_debug("adding header> $field_name: $field_value") @@ -881,8 +871,8 @@ sub add_header ($$$$) { # leave_first: leave the first appeared header line if true # return value: none # -sub kill_header ($$$) { - my ($Header, $field_name, $leave_first) = @_; +sub kill_header($$$) { + my($Header, $field_name, $leave_first) = @_; my $i; for ($i = 0; $i <= $#$Header; $i++) { @@ -903,7 +893,7 @@ sub kill_header ($$$) { # header: reference to a message header array # return value: none # -sub kill_empty_header ($) { +sub kill_empty_header($) { my $Header = shift; my $i; @@ -922,12 +912,12 @@ sub kill_empty_header ($) { # name_list: leave the first appeared header line if true # return value: none # -sub sort_header ($$) { - my ($Header, $name_list) = @_; - my ($i, $label, @tail); +sub sort_header($$) { + my($Header, $name_list) = @_; + my($i, $label, @tail); foreach $label (split(',', $name_list)) { - for ($i = 0; $i <= $#$Header; ) { + for ($i = 0; $i <= $#$Header;) { if ($$Header[$i] =~ /^$label:/i) { push (@tail, $$Header[$i]); splice(@$Header, $i, 1); @@ -946,8 +936,8 @@ sub sort_header ($$) { # str2: a header string to be appended to str1 # return value: a concatinated header string # -sub hdr_cat ($$) { - my ($str1, $str2) = @_; +sub hdr_cat($$) { + my($str1, $str2) = @_; if ($str1 eq '' || $str1 =~ /\n[\t ]+$/) { return "$str1$str2"; @@ -964,6 +954,53 @@ sub hdr_cat ($$) { 1; +__END__ + +=head1 NAME + +IM::Message - mail/news message handler + +=head1 SYNOPSIS + + use IM::Message; + +Subroutines: +read_header +message_size +put_header +read_body +put_body +rewrite_header +rewrite_resend_header +body_qp_encode +body_base64_encode +put_mimed_bcc +put_mimed_partial +put_mimed_error_notify +set_crlf +crlf +gen_message_id +gen_date +header_value +add_header +kill_header +kill_empty_header +sort_header + +=head1 DESCRIPTION + +The I<IM::Message> module handles mail/news messages. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/MsgStore.pm b/img/dist/IM/IM/MsgStore.pm index 61a1c90e..9e100293 100644 --- a/img/dist/IM/IM/MsgStore.pm +++ b/img/dist/IM/IM/MsgStore.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::MsgStore.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::MsgStore.pm version 20021207(IM142)"; package IM::MsgStore; require 5.003; @@ -27,16 +27,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(store_message exec_getsbrfile open_fcc excl_create fsync); -=head1 NAME - -MsgStore - store message in MH-style folder - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw($MsgNum $PrevFolder $First $Last $PrevDst $sys_fsync); BEGIN { $MsgNum = 0; @@ -54,7 +44,7 @@ BEGIN { # success: file name to be saved # fail: NULL # -sub new_message (\*$) { +sub new_message(\*$) { (local *MESSAGE, my $folder) = @_; if ($folder ne $PrevFolder) { $MsgNum = 0; @@ -68,7 +58,11 @@ sub new_message (\*$) { } $First = $Last = $MsgNum; } else { - $MsgNum++; + $MsgNum = message_number($folder, 'new', ($MsgNum)); + if ($MsgNum == 0) { + im_warn("can't get new message number in $folder\n"); + return ('', ''); + } } my $try = 3; while ($try--) { @@ -83,15 +77,19 @@ sub new_message (\*$) { $Last = $MsgNum; return ("$folder/$MsgNum", $file); } - $MsgNum++; + $MsgNum = message_number($folder, 'new', ($MsgNum)); + if ($MsgNum == 0) { + im_warn("can't get new message number in $folder\n"); + return ('', ''); + } } im_warn("excl_create failed.\n"); # message creation failed return ('', ''); } -sub store_message ($$;$) { - my ($Msg, $dst, $noscan) = @_; +sub store_message($$;$) { + my($Msg, $dst, $noscan) = @_; local *ART; require IM::Scan && import IM::Scan qw(store_header parse_header parse_body disp_msg); @@ -104,7 +102,7 @@ sub store_message ($$;$) { touch_folder($dst); $PrevDst = $dst; } - my ($msgfile, $filepath) = &new_message(\*ART, $dst); + my($msgfile, $filepath) = &new_message(\*ART, $dst); my $size = 0; if ($filepath ne '') { my $line; @@ -190,7 +188,7 @@ sub store_message ($$;$) { } } -sub exec_getsbrfile ($) { +sub exec_getsbrfile($) { my $dst = shift; my $get_hook = getsbr_file(); if ($get_hook) { @@ -229,9 +227,9 @@ sub exec_getsbrfile ($) { # path: file name to be saved # rm_file_on_error: a path to be deleted on error # -sub open_fcc ($$) { - my ($folder, $dir_style) = @_; - my ($fcc_dir, $rm_file_on_error, $fcc_folder, $FILE, $msgfile); +sub open_fcc($$) { + my($folder, $dir_style) = @_; + my($fcc_dir, $rm_file_on_error, $fcc_folder, $FILE, $msgfile); $fcc_folder = &expand_path($folder); if (-d $fcc_folder) { @@ -286,14 +284,14 @@ sub open_fcc ($$) { # 0: success # -1: fail # -sub excl_create (*$) { +sub excl_create(*$) { (local *MESSAGE, my $file) = @_; msg_mode(1); return -1 unless (im_sysopen(\*MESSAGE, $file, file_attr())); return 0; } -sub fsync ($) { +sub fsync($) { my $fno = shift; if (fsync_no()) { @@ -340,6 +338,33 @@ sub fsync ($) { 1; +__END__ + +=head1 NAME + +IM::MsgStore - store message in MH-style folder + +=head1 SYNOPSIS + + use IM::MsgStore; + +Subroutines: +store_message exec_getsbrfile open_fcc excl_create fsync + +=head1 DESCRIPTION + +The I<IM::MsgStore> module stores mail/news messages in MH-style folder. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Nntp.pm b/img/dist/IM/IM/Nntp.pm index 49b50cd8..9751d9c5 100644 --- a/img/dist/IM/IM/Nntp.pm +++ b/img/dist/IM/IM/Nntp.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Nntp.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Nntp.pm version 20021207(IM142)"; package IM::Nntp; require 5.003; @@ -39,20 +39,6 @@ use vars qw(@ISA @EXPORT); nntp_spec ); -=head1 NAME - -NNTP - NNTP interface package - -=head1 SYNOPSIS - -$return_code = &nntp_transaction(server_list, newsgroups, - part_current, part_total, authuser); -$return_code = &nntp_close; - -=head1 DESCRIPTION - -=cut - use vars qw($Nntp_opened *NNTPd $NntpErrTitle); ##### NNTP SESSION OPENING ##### @@ -64,8 +50,8 @@ use vars qw($Nntp_opened *NNTPd $NntpErrTitle); # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub nntp_open ($$) { - my ($servers, $logging) = @_; +sub nntp_open($$) { + my($servers, $logging) = @_; my $rc; if ($Nntp_opened) { @@ -79,7 +65,7 @@ sub nntp_open ($$) { if ($rc = &tcp_command(\*NNTPd, '', '')) { return $rc; } - my (@resp) = &command_response; + my(@resp) = &command_response; if ($resp[0] =~ /InterNetNews server INN/) { return 1 if (&tcp_command(\*NNTPd, 'MODE reader', '')); } @@ -95,7 +81,7 @@ sub nntp_open ($$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub nntp_close () { +sub nntp_close() { return 0 unless ($Nntp_opened); $Nntp_opened = 0; im_notice("closing NNTP session.\n"); @@ -117,8 +103,8 @@ sub nntp_close () { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub nntp_transaction ($$$$$$$) { - my ($servers, $Header, $Body, $group, $part, $total, $authuser) = @_; +sub nntp_transaction($$$$$$$) { + my($servers, $Header, $Body, $group, $part, $total, $authuser) = @_; my $rc; require IM::Log && import IM::Log; @@ -126,7 +112,7 @@ sub nntp_transaction ($$$$$$$) { &set_nntpauthuser($authuser); do { $rc = &nntp_transact_sub($servers, $Header, $Body, $part, $total); - my (@resp) = &command_response; + my(@resp) = &command_response; if ($rc) { &im_warn($NntpErrTitle . join("\n", @resp) . "\n"); $NntpErrTitle = ''; @@ -153,8 +139,8 @@ sub nntp_transaction ($$$$$$$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub nntp_transact_sub ($$$$$) { - my ($servers, $Header, $Body, $part, $total) = @_; +sub nntp_transact_sub($$$$$) { + my($servers, $Header, $Body, $part, $total) = @_; my $rc; return $rc if ($rc = &nntp_open($servers, 1)); @@ -177,9 +163,9 @@ sub nntp_transact_sub ($$$$$) { return 0; } -sub nntp_head_as_string ($) { +sub nntp_head_as_string($) { my $i = shift; - my ($rc, $count) = ('', 0); + my($rc, $count) = ('', 0); local $_; im_notice("getting article $i.\n"); @@ -190,7 +176,7 @@ sub nntp_head_as_string ($) { return -1; } $count++; - my ($found, $f) = (0, ''); + my($found, $f) = (0, ''); alarm(nntp_timeout()) unless win95p(); $! = 0; while (<NNTPd>) { @@ -211,8 +197,8 @@ sub nntp_head_as_string ($) { return $f; } -sub nntp_head ($$) { - my ($art_start, $art_end) = @_; +sub nntp_head($$) { + my($art_start, $art_end) = @_; local $_; my $count = 0; @@ -226,7 +212,7 @@ sub nntp_head ($$) { return -1; } $count++; - my ($found, $f) = (0, ''); + my($found, $f) = (0, ''); alarm(nntp_timeout()) unless win95p(); $! = 0; while (<NNTPd>) { @@ -257,8 +243,8 @@ sub nntp_head ($$) { return $count; } -sub nntp_xover ($$) { - my ($art_start, $art_end) = @_; +sub nntp_xover($$) { + my($art_start, $art_end) = @_; my $rc = &tcp_command(\*NNTPd, "XOVER $art_start-$art_end", ''); if ($rc) { @@ -266,7 +252,7 @@ sub nntp_xover ($$) { return -1; } my $count = 0; - my ($resp); + my($resp); while (($resp = &next_response(\*NNTPd)) !~ /^\.$/) { $count++; my @overview = split('\t', $resp); @@ -285,17 +271,17 @@ sub nntp_xover ($$) { return $count; } -sub nntp_article ($) { +sub nntp_article($) { my $num = shift; local $_; -# local (@Article); +# local(@Article); im_debug("getting article $num.\n") if (&debug('nntp')); my $rc = &tcp_command(\*NNTPd, "ARTICLE $num", ''); - return (1, '') if ($rc > 0); + return(1, '') if ($rc > 0); if ($rc < 0) { im_warn("ARTICLE command failed.\n"); - return (-1, ''); + return(-1, ''); } my @Article = (); alarm(nntp_timeout()) unless win95p(); @@ -305,7 +291,7 @@ sub nntp_article ($) { alarm(0); if ($!) { # may be channel truoble im_warn("lost connection for ARTICLE.\n"); - return (-1, ''); + return(-1, ''); } } s/\r\n$/\n/; @@ -315,12 +301,12 @@ sub nntp_article ($) { im_debug($_) if (&debug('nntp')); } alarm(0) unless win95p(); - return (0, \@Article); + return(0, \@Article); } -sub nntp_articles ($$$$) { - my ($art_start, $art_end, $dst, $limit) = @_; - my ($rc, $article); +sub nntp_articles($$$$) { + my($art_start, $art_end, $dst, $limit) = @_; + my($rc, $article); my $count = 0; my $last = 0; @@ -343,10 +329,10 @@ sub nntp_articles ($$$$) { last if ($limit && --$limit == 0); } &exec_getsbrfile($dst); - return ($count, $last); + return($count, $last); } -sub nntp_list ($) { +sub nntp_list($) { my $group = shift; local $_; my $rc; @@ -366,13 +352,13 @@ sub nntp_list ($) { return $count; } -sub nntp_command ($) { +sub nntp_command($) { my $cmd = shift; my $rc = &tcp_command(\*NNTPd, $cmd, ''); return -1 if ($rc < 0); if ($rc > 0) { - my ($res) = &command_response(); + my($res) = &command_response(); if ($res =~ /^480/) { require IM::GetPass && import IM::GetPass; @@ -382,7 +368,7 @@ sub nntp_command ($) { my $user = &nntpauthuser() || $ENV{'USER'} || $ENV{'LOGNAME'} || im_getlogin(); my $host = get_cur_server(); - my ($pass, $agtfound, $interact) + my($pass, $agtfound, $interact) = getpass('nntp', 'PASS', $host, $user); # authenticate for posting @@ -398,29 +384,29 @@ sub nntp_command ($) { return $rc; } -sub nntp_command_response () { +sub nntp_command_response() { return &command_response; } -sub nntp_next_response () { +sub nntp_next_response() { return &next_response(\*NNTPd); } -sub set_last_article_number ($$$) { - my ($server, $group, $number) = @_; - my ($pos, $last, $size) = (0, 0, 0); +sub set_last_article_number($$$) { + my($server, $group, $number) = @_; + my($pos, $last, $size) = (0, 0, 0); $server =~ s!\%\d+$!!; $server =~ s!/\d+$!!; my $nntphist = &nntphistoryfile() . '-' . $server; - if ( -f $nntphist ) { + if (-f $nntphist) { im_open(\*NEWSHIST, "+<$nntphist"); while ($pos = tell(NEWSHIST), $_ = <NEWSHIST>) { /^([^:]+):\s*(\d+)/; if ($group eq $1) { $last = $2; im_debug("$last articles in $group ($nntphist)\n") - if(&debug('nntp')); + if (&debug('nntp')); seek(NEWSHIST, $pos, 0); $size = length($_) - length("$group: 0000000\n"); if ($size < 0) { @@ -445,8 +431,8 @@ sub set_last_article_number ($$$) { return $last; } -sub get_last_article_number ($$) { - my ($server, $group) = @_; +sub get_last_article_number($$) { + my($server, $group) = @_; local $_; my $number = 0; @@ -467,33 +453,33 @@ sub get_last_article_number ($$) { } -sub nntp_get_message ($$) { - my ($src, $msg) = @_; - my ($rc, $art); - my ($group, $srvs) = nntp_spec($src, nntpservers()); +sub nntp_get_message($$) { + my($src, $msg) = @_; + my($rc, $art); + my($group, $srvs) = nntp_spec($src, nntpservers()); my @servers = split(',', $srvs); im_notice("accessing to $group on $srvs.\n"); do { if (($rc = nntp_open(\@servers, 0)) < 0) { - return (-1, "can not connect $srvs.\n"); + return(-1, "can not connect $srvs.\n"); } if (($group ne '') && ($rc = nntp_command("GROUP $group")) < 0) { - return (-1, "can not access $group.\n"); + return(-1, "can not access $group.\n"); } } while (@servers > 0 && $rc > 0); - return (-1, "can not access $group on $srvs.\n") if ($rc); + return(-1, "can not access $group on $srvs.\n") if ($rc); ($rc, $art) = nntp_article($msg); nntp_close(); - return (-1, "no message $msg in -$group.\n") if ($rc); - return (0, $art); + return(-1, "no message $msg in -$group.\n") if ($rc); + return(0, $art); } # returns number of got articles # -1 if error -sub nntp_get_msg ($$$$) { - my ($src, $dst, $how, $limit) = @_; - my ($rc, $group, $error, $art_start, $art_end); - my ($servers, @servers); +sub nntp_get_msg($$$$) { + my($src, $dst, $how, $limit) = @_; + my($rc, $group, $error, $art_start, $art_end); + my($servers, @servers); if ($src =~ /^nntp:(.*)/i || $src =~ /^news:(.*)/i) { ($group, $servers) = &nntp_spec($1, nntpservers()); @@ -514,7 +500,7 @@ sub nntp_get_msg ($$$$) { } while (@servers > 0 && $rc > 0); return -1 if ($rc); - my (@resp) = &command_response; + my(@resp) = &command_response; $error = 0; my $i; for ($i = 0; $i <= $#resp; $i++) { @@ -535,7 +521,7 @@ sub nntp_get_msg ($$$$) { return -1; } - my ($art_last, $msgs); + my($art_last, $msgs); $art_last = &get_last_article_number($servers, $group); if ($art_end > $art_last) { # new articles @@ -587,7 +573,7 @@ sub nntp_get_msg ($$$$) { } if ($how eq 'get') { - my ($last); + my($last); if ($msgs > 0) { im_info("Getting new messages from $group at $servers " . "into $dst....\n"); @@ -609,8 +595,8 @@ sub nntp_get_msg ($$$$) { } # News group (-group[@server]) -sub nntp_spec ($$) { - my ($spec, $server) = @_; +sub nntp_spec($$) { + my($spec, $server) = @_; my $group; if ($spec =~ /^-(.*)/) { @@ -621,11 +607,51 @@ sub nntp_spec ($$) { } else { $group = $spec; } - return ($group, $server); + return($group, $server); } 1; +__END__ + +=head1 NAME + +IM::Nntp - NNTP hanlder + +=head1 SYNOPSIS + + use IM::Nntp; + + $return_code = &nntp_transaction(server_list, newsgroups, + part_current, part_total, authuser); + $return_code = &nntp_close; + +Other subroutines: +nntp_open +nntp_article +nntp_list +nntp_command +nntp_command_response +nntp_next_response +nntp_get_message +nntp_get_msg +nntp_head_as_string +nntp_spec + +=head1 DESCRIPTION + +The I<IM::Nntp> module handles NNTP. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Pop.pm b/img/dist/IM/IM/Pop.pm index feb28f22..8486edaa 100644 --- a/img/dist/IM/IM/Pop.pm +++ b/img/dist/IM/IM/Pop.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Pop.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Pop.pm version 20021207(IM142)"; package IM::Pop; require 5.003; @@ -27,16 +27,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(pop_get_msg pop_spec); -=head1 NAME - -Pop - POP handling package - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw(*POPd $SERVER_IDENT %history %newhistory); ####################### # POP access routines # @@ -54,11 +44,11 @@ use vars qw(*POPd $SERVER_IDENT %history %newhistory); # -1: failure # -2: failure (connection) # -sub pop_open ($$$$) { - my ($auth, $host, $user, $pass) = @_; +sub pop_open($$$$) { + my($auth, $host, $user, $pass) = @_; my $prompt = lc("pop/$auth:$user\@$host"); - my ($resp, $pwd, $errmsg); - my (@host_list) = ($host); + my($resp, $pwd, $errmsg); + my(@host_list) = ($host); im_notice("opening POP session ($auth)\n"); if ($auth eq 'RPOP' && !$main::SUIDROOT) { im_warn("RPOP operation requires SUID root.\n"); @@ -126,7 +116,7 @@ sub pop_open ($$$$) { return 0; } -sub pop_close () { +sub pop_close() { im_notice("closing POP session.\n"); my $resp = &send_command(\*POPd, 'QUIT', ''); return -1 if ($resp !~ /^\+/); @@ -134,8 +124,8 @@ sub pop_close () { return 0; } -sub pop_stat () { - my (@field); +sub pop_stat() { + my(@field); im_notice("getting number of message.\n"); my $resp = &send_command(\*POPd, 'STAT', ''); if ($resp !~ /^\+/) { @@ -147,10 +137,10 @@ sub pop_stat () { return $field[1]; } -sub pop_retr ($$$) { - my ($num, $dst, $noscan) = @_; - local ($_); - my (@Message); +sub pop_retr($$$) { + my($num, $dst, $noscan) = @_; + local($_); + my(@Message); im_notice("getting message $num.\n"); my $resp = &send_command(\*POPd, "RETR $num", ''); if ($resp !~ /^\+/) { @@ -181,7 +171,7 @@ sub pop_retr ($$$) { return 0; } -sub pop_head ($) { +sub pop_head($) { my $num = shift; im_notice("getting header of message $num.\n"); my $resp = &send_command(\*POPd, "TOP $num 1", ''); @@ -189,9 +179,9 @@ sub pop_head ($) { im_warn("TOP command failed.\n"); return 0; } - my ($field, $inheader) = ('', 1); - local ($_); - my (%head); + my($field, $inheader) = ('', 1); + local($_); + my(%head); undef %head; alarm(pop_timeout()) unless win95p(); $! = 0; @@ -227,7 +217,7 @@ sub pop_head ($) { return \%head; } -sub pop_dele ($) { +sub pop_dele($) { my $num = shift; im_notice("deleting message $num.\n"); my $resp = &send_command(\*POPd, "DELE $num", ''); @@ -238,7 +228,7 @@ sub pop_dele ($) { return 0; } -sub pop_uidl ($) { +sub pop_uidl($) { my $uidlp = shift; local $_; im_notice("getting UIDL information.\n"); @@ -269,9 +259,9 @@ sub pop_uidl ($) { } # pop_process(socket, how) -sub pop_process ($$$$) { - my ($how, $host, $dst, $noscan) = @_; - my ($histfile, $head, $msgs, $i, $h, $new, $last); +sub pop_process($$$$) { + my($how, $host, $dst, $noscan) = @_; + my($histfile, $head, $msgs, $i, $h, $new, $last); return -1 if (($msgs = &pop_stat) < 0); my $keep_proto = 'UIDL'; # UIDL/LAST/STATUS/MSGID @@ -432,9 +422,9 @@ sub pop_process ($$$$) { return $new; } -sub pop_inc ($$$$$$$$) { - my ($msgs, $host, $dst, $last, $keep_proto, $histp, $uidlp, $noscan) = @_; - my ($accesstime, $i, $h, $head); +sub pop_inc($$$$$$$$) { + my($msgs, $host, $dst, $last, $keep_proto, $histp, $uidlp, $noscan) = @_; + my($accesstime, $i, $h, $head); my $got = 0; my $ttl = 0; @@ -530,14 +520,14 @@ sub pop_inc ($$$$$$$$) { return $got; } -sub pop_get_msg ($$$$) { - my ($src, $dst, $how, $noscan) = @_; +sub pop_get_msg($$$$) { + my($src, $dst, $how, $noscan) = @_; $src =~ s/^pop//i; - my ($auth, $user, $host) = &pop_spec($src); + my($auth, $user, $host) = &pop_spec($src); - my ($pass, $agtfound, $interact) = ('', 0, 0); + my($pass, $agtfound, $interact) = ('', 0, 0); ($pass, $agtfound, $interact) = getpass ('pop', $auth, $host, $user) unless $auth eq 'RPOP'; @@ -563,7 +553,7 @@ sub pop_get_msg ($$$$) { } # POP folder (--src=pop[//auth][:user][@server[/port]]) -sub pop_spec ($) { +sub pop_spec($) { my $spec = shift; if ($spec eq '' || $spec !~ /[:\@]|\/\//) { @@ -577,7 +567,7 @@ sub pop_spec ($) { } $spec .= $s if ($s ne ''); } - my ($auth, $host) = ('apop', 'localhost'); + my($auth, $host) = ('apop', 'localhost'); my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || im_getlogin(); if ($spec =~ /^\/\/?(\w+)(.*)/) { @@ -613,6 +603,34 @@ sub pop_spec ($) { 1; +__END__ + +=head1 NAME + +IM::Pop - POP handler + +=head1 SYNOPSIS + + use IM::Pop; + + $msgs = pop_get_msg($src, $dst, $mode, $noscan); + + ($auth, $user, $host) = pop_spec($src) + +=head1 DESCRIPTION + +The I<IM::Pop> module handles Pop. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Recipient.pm b/img/dist/IM/IM/Recipient.pm index 353df12b..7cec8467 100644 --- a/img/dist/IM/IM/Recipient.pm +++ b/img/dist/IM/IM/Recipient.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 27, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Recipient.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Recipient.pm version 20021207(IM142)"; package IM::Recipient; require 5.003; @@ -27,29 +27,19 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(add_to_rcpt parse_rcpt rcpt_pickup); -=head1 NAME - -Recipient - IM recipient handler - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw($Alias_match_count $Include_count %Include_Files); ##### ADD AN ADDRESS TO RECIPIENT LIST ##### # -# add_to_rctp(bcc_flag, addr) +# add_to_rcpt(bcc_flag, addr) # bcc_flag: register with "bcc" tag # addr: an address to be registered # return value: none # 0: success # -1: failure # -sub add_to_rcpt ($$) { - my ($bcc_flag, $addr) = @_; - my ($rec, $a); +sub add_to_rcpt($$) { + my($bcc_flag, $addr) = @_; + my($rec, $a); $addr = &extract_addr($addr); return -1 if ($addr eq ''); return 0 unless ($addr); @@ -89,7 +79,7 @@ sub add_to_rcpt ($$) { ##### PARSE RECIPIENT LIST ##### # -# sub parse_rcpt(bcc_flag, addr_list, need_code_conversion) +# parse_rcpt(bcc_flag, addr_list, need_code_conversion) # bcc_flag: # 1 = BCC distination # 0 = normal distination @@ -97,9 +87,9 @@ sub add_to_rcpt ($$) { # addr_list: address list string (concatinated with ",") # return value: number of addresses in the list (-1 if error) # -sub parse_rcpt ($$$) { - my ($bcc_flag, $addr_list, $conv) = @_; - my ($cnt, $addr); +sub parse_rcpt($$$) { + my($bcc_flag, $addr_list, $conv) = @_; + my($cnt, $addr); $addr_list =~ s/^\s+//; $addr_list =~ s/\n\s*//g; # XXX return 0 if ($addr_list eq ''); @@ -148,13 +138,13 @@ sub parse_rcpt ($$$) { # 0: success # -1: failure # -sub expn_group ($$) { - my ($bcc_flag, $group_expression) = @_; - my ($rest, @mboxes, $rec); +sub expn_group($$) { + my($bcc_flag, $group_expression) = @_; + my($rest, @mboxes, $rec); # return if ($group_expression !~ /:.*;$/); return if ($group_expression !~ /:[^;]*;/); im_debug("expanding $group_expression\n") if (&debug('rcpt')); -# my ($group_name); +# my($group_name); # $group_name = $group_expression; # $group_name =~ s/:.*/:;/; $rest = $group_expression; @@ -181,10 +171,10 @@ sub expn_group ($$) { # 0: success # -1: failure # -sub expn_rcpt_list ($$) { - my ($bcc_flag, $include_file) = @_; - my ($file) = &expand_path($include_file); - my ($INCLUDE) = &include_open($file); +sub expn_rcpt_list($$) { + my($bcc_flag, $include_file) = @_; + my($file) = &expand_path($include_file); + my($INCLUDE) = &include_open($file); if ($INCLUDE) { while (defined($_ = include_readline($INCLUDE))) { chomp; @@ -205,7 +195,7 @@ sub expn_rcpt_list ($$) { } elsif (/^\s*\//) { im_err("Mail to file not supported: $_\n"); return -1; - } elsif (/^\s*\|/ || /^\s*"\s*\|/) { + } elsif (/^\s*\|/ || /^\s*"\s*\|/) { #" im_err("Mail to program not supported: $_\n"); return -1; } @@ -228,8 +218,8 @@ sub expn_rcpt_list ($$) { # -1: failure # 0: success # -sub rcpt_pickup ($$$) { - my ($Header, $resend_flag, $news_only_flag) = @_; +sub rcpt_pickup($$$) { + my($Header, $resend_flag, $news_only_flag) = @_; my $line; my $resend_prefix; @@ -262,25 +252,71 @@ sub rcpt_pickup ($$$) { # return value: handle # no strict 'refs'; -sub include_open ($) { - my ($file) = shift; +sub include_open($) { + my($file) = shift; return undef if $Include_Files{$file}; im_open($file, $file) || return undef; $Include_Files{$file} = 1; return $file; } -sub include_readline ($) { +sub include_readline($) { my $fh = shift; return scalar(<$fh>); } -sub include_close ($) { - my ($fh) = shift; +sub include_close($) { + my($fh) = shift; close($fh); delete $Include_Files{$fh}; } 1; +__END__ + +=head1 NAME + +IM::Recipient - mail/news recipient handler + +=head1 SYNOPSIS + + use IM::Recipient; + + add_to_rcpt(bcc_flag, addr) + bcc_flag: register with "bcc" tag + addr: an address to be registered + return value: none + 0: success + -1: failure + + parse_rcpt(bcc_flag, addr_list, need_code_conversion) + bcc_flag: + 1 = BCC distination + 0 = normal distination + -1 = parse only + addr_list: address list string (concatinated with ",") + return value: number of addresses in the list (-1 if error) + + rcpt_pickup(header, resend_flag, news_only_flag) + resend_flag: pickup addresses for redistributing mode + news_only_flag: do not pickup destination addresses for news mode + return value: + -1: failure + 0: success + +=head1 DESCRIPTION + +The I<IM::Recipient> module handles recipient of mail/news message. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Scan.pm b/img/dist/IM/IM/Scan.pm index 9c14d9c9..c31c0e69 100644 --- a/img/dist/IM/IM/Scan.pm +++ b/img/dist/IM/IM/Scan.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Scan.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Scan.pm version 20021207(IM142)"; package IM::Scan; require 5.003; @@ -28,97 +28,6 @@ use vars qw(@ISA @EXPORT); @EXPORT = qw(set_scan_form get_header store_header parse_body parse_header disp_msg read_petnames); -=head1 NAME - - Scan - Scan listing from mail - -=head1 SYNOPSIS - - use IM::Scan; - - &set_scan_form($scan_form, $width, $use_jis); - &read_petnames(); - %Head = &get_header($mail_file); - &disp_msg(\%Head); - -=head1 DESCRIPTION - -=head1 FILES - - $HOME/.im/Config the user profile - -=head1 PROFILE COMPONENTS - - Component Explanation Example - - MailDir: your mail directory Mail - Width: one line width 80 - JisSafe: safely substr for ISO-2022-JP on - Form: scan format %+5n %m%d %8f %-30S %b - PetnameFile: nickname file ~/.im/Petname - Address: your mail addresses kazu@mew.org, kazu@wide.ad.jp - AddrRegex: regexp of your addresses ^kazu@.*$ - if necessary - -=head1 SCAN FORMAT - - '%{width}{header-type}' format is available. You can define any - header-type as you want. Default valid header-types are - - %n message number - %d raw Date: field - %f MIME decoded From: field - %t MIME decoded To: filed - %g raw Newsgroups: field - %a friendly From: field - %A If this message is originated by yourself, friendly To: - or raw Newsgroups: is displayed in 'To:xxx' or 'Ng:xxx' - format, respectively. Otherwise, friendly From: field is - displayed. - %P Similar to %A, but diplay raw address of mail sender - instead of friendly From: field, just like mh-e. - %i indent to display thread - %s MIME decoded Subject: field - %S indented MIME decoded Subject (same as %i+%s) - %b a part of body extracted with heuristic - %m Multipart type - 'S'igned, 'E'ncrypt, 'M'ultipart, 'P'artial or none - %p mark '*' if the message is destined to you - %D mark 'D' if the message is duplicated - %M %p+%D - %F folder path -# %B file size - %K file block size (1024 bytes/block) - - %y year - %c month (digit) - %C month (string) - %e mday - %h hour - %E min - %G sec - - {width} is a integer with/without '-' sign. if a '-' sign exists, content - of a header-type will be displaied with left adjustment. If the integer - have leading '0', the field will be padded with leading '0's. - - To improve processing speed, needless process on JIS character should be - avoided. Even if 'JisSafe' is on, only %f, %t, %A, %s, %S and %b are - processed with 'substr' routine for JIS characters by default. If you want - to process other header-types with JIS version of 'substr', specify '!' - just after '%' like: %!-8S. - - ScanForm "%+5n %m%d %-14A %-18S %b" works as same as IM default scaning. - -=head1 PETNAMES FORMAT - - Following format is valid in petnames file. - A line beginning with '#' is ignored. - # This is comments - Kazu@Mew.org "Mr.Kazu" - nom@Mew.org "Nomsun" - -=cut use vars qw($WIDTH $JIS_SAFE $HEADLINELIMIT $BODYLINELIMIT $MSTR2NUM @MSTR @WSTR %symbol_table %multipart_mark @NEEDSAFE %NEEDSAFE_HASH @@ -188,8 +97,8 @@ BEGIN { 'sig' => 'S', ); - @NEEDSAFE = qw (from: to: cc: address: Address: - subject: indent-subject: body: ); + @NEEDSAFE = qw(from: to: cc: address: Address: + subject: indent-subject: body:); %NEEDSAFE_HASH = (); @@ -203,8 +112,8 @@ BEGIN { ## If user specifies a scan format, convert that to 'eval-form'. ## -sub set_scan_form ($$$) { - my ($scan_form, $width, $jis_safe) = @_; +sub set_scan_form($$$) { + my($scan_form, $width, $jis_safe) = @_; $ALLOW_CRLF = allowcrlf(); @@ -233,7 +142,7 @@ sub set_scan_form ($$$) { ## get_header ## -sub get_header ($) { +sub get_header($) { my $path = shift; my %Head = (); my $folder; @@ -301,8 +210,8 @@ foreach (@STRUCTURED) { $STRUCTURED_HASH{$_} = 1; } -sub store_header ($$) { - my ($href, $header) = @_; +sub store_header($$) { + my($href, $header) = @_; local $_; my $lines = 0; @@ -334,10 +243,10 @@ sub store_header ($$) { # mode: 1 if HANDLER is File Handler, otherwise HANDLER is Array # return value: substring from body # -sub parse_body (*$) { +sub parse_body(*$) { local *HANDLE = shift; my $mode = shift; - my ($content, $lines) = ('', 0); + my($content, $lines) = ('', 0); while (1) { if ($mode == 0) { @@ -351,7 +260,7 @@ sub parse_body (*$) { next if /^\s*\n/; next if /^--/; next if /^- --/; - next if /^\s+[\w-*]+=/; # eg. "boundary="; * = RFC2231 + next if /^\s+[\w*-]+=/; # eg. "boundary="; * = RFC2231 next if /^\s*[\w-]+: /; # Headers and header style citation next if /^\s*[\w-]*[>|]/; # other citation next if /:\n$/; @@ -385,7 +294,7 @@ sub parse_body (*$) { return substr_safe($content, $WIDTH); } -sub parse_header ($) { +sub parse_header($) { my $href = shift; ## @@ -409,10 +318,10 @@ sub parse_header ($) { if ($href->{'date'}) { $href->{'date:'} = $href->{'date'}; } else { - my ($sec, $min, $hour, $mday, $mon, $year, - $wday, $yday, $isdst) = localtime((stat($href->{'path'}))[9]); - my ($gsec, $gmin, $ghour, $gmday, $gmon, $gyear, - $gwday, $gyday, $gisdst) = gmtime((stat($href->{'path'}))[9]); + my($sec, $min, $hour, $mday, $mon, $year, + $wday, $yday, $isdst) = localtime((stat($href->{'path'}))[9]); + my($gsec, $gmin, $ghour, $gmday, $gmon, $gyear, + $gwday, $gyday, $gisdst) = gmtime((stat($href->{'path'}))[9]); my $off = ($hour - $ghour) * 60 + $min - $gmin; if ($year < $gyear) { @@ -439,11 +348,11 @@ sub parse_header ($) { } $href->{'date:'} =~ /(\d\d?)\s+([A-Za-z]+)\s+(\d+)\s/; - my ($mday, $monthstr, $year) = ($1, "\u\L$2", $3); + my($mday, $monthstr, $year) = ($1, "\u\L$2", $3); my $mon = $MSTR2NUM->{$monthstr}; $href->{'date:'} =~ /\s(\d\d?):(\d\d?)/; - my ($hour, $min, $sec) = ($1, $2, 0); + my($hour, $min, $sec) = ($1, $2, 0); if ($href->{'date:'} =~ /\s\d\d?:\d\d?:(\d\d?)\s/) { $sec = $1; } @@ -510,7 +419,7 @@ sub parse_header ($) { if ($REF_SYMBOL{'pureaddr:'}) { if (my_addr($href->{'from'})) { if ($href->{'to'}) { - my ($to, $rest) = &fetch_addr($href->{'to'}, 1); + my($to, $rest) = &fetch_addr($href->{'to'}, 1); if ($to) { $href->{'pureaddr:'} = 'To:' . $to; } @@ -552,8 +461,8 @@ sub parse_header ($) { &scan_sub($href) if (defined(&scan_sub)); } -sub disp_msg ($;$) { - my ($href, $vscan) = @_; +sub disp_msg($;$) { + my($href, $vscan) = @_; $href->{'indent:'} = '' unless defined($href->{'indent:'}); $href->{'subject:'} = '' unless defined($href->{'subject:'}); @@ -586,11 +495,11 @@ sub disp_msg ($;$) { ## Convert into Friendly Address ## -sub friendly_addr ($$) { - my ($addr, $need_addr) = @_; +sub friendly_addr($$) { + my($addr, $need_addr) = @_; return '' unless $addr; my $friendly = ''; - my ($a, $f, $p); + my($a, $f, $p); while (($a, $addr, $f) = &fetch_addr($addr, 1), $a ne '') { $a =~ s/\/[^@]*//; if (defined(%petnames) && $petnames{lc($a)}) { @@ -616,14 +525,14 @@ sub friendly_addr ($$) { %ADDRESS_HASH = (); -sub my_addr (@) { +sub my_addr(@) { my @addrs = @_; my $addr; unless (defined($ADDRESS_HASH{'init'})) { $ADDRESS_HASH{'addr'} = addresses_regex(); unless ($ADDRESS_HASH{'addr'}) { - $ADDRESS_HASH{'addr'} = '^' . quotemeta(address()) . '$'; + $ADDRESS_HASH{'addr'} = '^' . quotemeta(address()) . '$'; #' $ADDRESS_HASH{'addr'} =~ s/(\\\s)*\\,(\\\s)*/\$|\^/g; } $ADDRESS_HASH{'init'} = 1; @@ -643,7 +552,7 @@ sub my_addr (@) { ## Convert scan_form() to 'eval-form' ## -sub convert_scan_form ($) { +sub convert_scan_form($) { my $SCANFORM = shift; if (!$main::INSECURE && $SCANFORM && $SCANFORM !~ /%/) { @@ -652,7 +561,7 @@ sub convert_scan_form ($) { } my @symbols = (); - my ($format, $jis_safe, $plus, $hyphen, $size, $type, $arg); + my($format, $jis_safe, $plus, $hyphen, $size, $type, $arg); if (scan_header_pick()) { my $elem; @@ -714,7 +623,7 @@ sub convert_scan_form ($) { $arg = join(',', @symbols); my $EVAL_SCAN_FORM = "sprintf('$format', $arg)"; - eval "sub scan_form { my (\$href) = shift; $EVAL_SCAN_FORM }"; + eval "sub scan_form { my(\$href) = shift; $EVAL_SCAN_FORM }"; if ($@) { im_die("Form seems to be wrong.\nPerl error message is: $@"); } @@ -734,7 +643,7 @@ BEGIN { $SS3 = "\x1b\x4f"; # <ISO 2022 Single_shift three> } -sub substr_safe ($$) { +sub substr_safe($$) { ($_, my $len) = @_; # This hack makes the code a few percent faster but it's kinda ugly. @@ -864,20 +773,19 @@ sub substr_safe ($$) { ## Read petnames entry ## -sub w2n ($) { +sub w2n($) { my $line = shift; $line =~ tr/\x20/\x0/; return $line; } -sub read_petnames () { - +sub read_petnames() { if (addrbook_file() && open(ADDRBOOK, addrbook_file())) { my $key; my $addr; my $petname; my $a; my @addrs; my $code; - while(<ADDRBOOK>) { + while (<ADDRBOOK>) { my $line = ''; do { chomp; @@ -893,7 +801,7 @@ sub read_petnames () { $line .= $_; } while (/[,\\]$/ && defined($_ = <ADDRBOOK>)); $_ = $line; - s/"([^"]+)"/w2n($1)/geo; + s/"([^"]+)"/w2n($1)/geo; #" s/,\s+/,/g; if (s/^(\S+)\s+(\S+)\s+(\S+)//) { $key = $1; @@ -921,11 +829,11 @@ sub read_petnames () { im_warn("can't open petname file $file\n"); return; } - while(<PETNAMES>) { + while (<PETNAMES>) { next if (/^$/); next if (/^#/); chomp; - my ($name, $petname); + my($name, $petname); if (/(\S+)\s+(.*)/) { $name = $1; $petname = $2; @@ -938,6 +846,111 @@ sub read_petnames () { 1; +__END__ + +=head1 NAME + +IM::Scan - scan listing from mail/news message + +=head1 SYNOPSIS + + use IM::Scan; + + &set_scan_form($scan_form, $width, $use_jis); + &read_petnames(); + %Head = &get_header($mail_file); + &disp_msg(\%Head); + +=head1 DESCRIPTION + +The I<IM::Scan> module handles scan format and petnames format +for mail/news message. + +This modules is provided by IM (Internet Message). + +=head1 FILES + + $HOME/.im/Config the user profile + +=head1 PROFILE COMPONENTS + + Component Explanation Example + + MailDir: your mail directory Mail + Width: one line width 80 + JisSafe: safely substr for ISO-2022-JP on + Form: scan format %+5n %m%d %8f %-30S %b + PetnameFile: nickname file ~/.im/Petname + Address: your mail addresses kazu@mew.org, kazu@wide.ad.jp + AddrRegex: regexp of your addresses ^kazu@.*$ + if necessary + +=head1 SCAN FORMAT + +'%{width}{header-type}' format is available. You can define any +header-type as you want. Default valid header-types are + + %n message number + %d raw Date: field + %f MIME decoded From: field + %t MIME decoded To: filed + %g raw Newsgroups: field + %a friendly From: field + %A If this message is originated by yourself, friendly To: + or raw Newsgroups: is displayed in 'To:xxx' or 'Ng:xxx' + format, respectively. Otherwise, friendly From: field is + displayed. + %P Similar to %A, but diplay raw address of mail sender + instead of friendly From: field, just like mh-e. + %i indent to display thread + %s MIME decoded Subject: field + %S indented MIME decoded Subject (same as %i+%s) + %b a part of body extracted with heuristic + %m Multipart type + 'S'igned, 'E'ncrypt, 'M'ultipart, 'P'artial or none + %p mark '*' if the message is destined to you + %D mark 'D' if the message is duplicated + %M %p+%D + %F folder path + %K file block size (1024 bytes/block) + + %y year + %c month (digit) + %C month (string) + %e mday + %h hour + %E min + %G sec + +{width} is a integer with/without '-' sign. if a '-' sign exists, content +of a header-type will be displaied with left adjustment. If the integer +have leading '0', the field will be padded with leading '0's. + +To improve processing speed, needless process on JIS character should be +avoided. Even if 'JisSafe' is on, only %f, %t, %A, %s, %S and %b are +processed with 'substr' routine for JIS characters by default. If you want +to process other header-types with JIS version of 'substr', specify '!' +just after '%' like: %!-8S. + +ScanForm "%+5n %m%d %-14A %-18S %b" works as same as IM default scaning. + +=head1 PETNAMES FORMAT + +Following format is valid in petnames file. +A line beginning with '#' is ignored. + + # This is comments + Kazu@Mew.org "Mr.Kazu" + nom@Mew.org "Nomsun" + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Smtp.pm b/img/dist/IM/IM/Smtp.pm index b913a2e4..af730a06 100644 --- a/img/dist/IM/IM/Smtp.pm +++ b/img/dist/IM/IM/Smtp.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Smtp.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Smtp.pm version 20021207(IM142)"; package IM::Smtp; require 5.003; @@ -28,21 +28,6 @@ use vars qw(@ISA @EXPORT); @EXPORT = qw(smtp_open smtp_close smtp_transaction smtp_transaction_for_error_notify); -=head1 NAME - -Smtp - SMTP interface package - -=head1 SYNOPSIS - -$return_code = &smtp_open(current_server, server_list, log_flag); -$return_code = &smtp_close(socket, savehist_flag); -$return_code = &smtp_transaction(bcc_flag, part_current, part_total); -$return_code = &smtp_transaction_for_error_notify; - -=head1 DESCRIPTION - -=cut - use vars qw(@Status $Smtp_opened *SMTPd $SmtpErrTitle $Esmtp_flag %ESMTP); ##### SMTP SESSION OPENING ##### @@ -56,8 +41,8 @@ use vars qw(@Status $Smtp_opened *SMTPd $SmtpErrTitle # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub smtp_open ($$$) { - my ($server, $server_list, $logging) = @_; +sub smtp_open($$$) { + my($server, $server_list, $logging) = @_; local $_; my $rc; my $svr = &get_cur_server_original_form(); @@ -77,7 +62,7 @@ sub smtp_open ($$$) { $SmtpErrTitle = "(while talking to " . &get_cur_server() . " with smtp)\n"; return $rc if ($rc = &tcp_command(\*SMTPd, '', '')); $Esmtp_flag = 0; - my (@resp) = &command_response; + my(@resp) = &command_response; if (join('/', @resp) =~ /ESMTP/) { $Esmtp_flag = 1; } @@ -85,7 +70,7 @@ sub smtp_open ($$$) { if ($Esmtp_flag) { unless (&tcp_command(\*SMTPd, "EHLO $main::Client_name", '')) { # ESMTP OK - my (@resp) = &command_response; + my(@resp) = &command_response; foreach (@resp) { if (/^250[ \-]([A-Z0-9]+)$/) { $ESMTP{$1} = 1; @@ -114,7 +99,7 @@ sub smtp_open ($$$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub smtp_close () { +sub smtp_close() { # @Status =(); return 0 unless ($SMTPd); return 0 unless ($Smtp_opened); @@ -137,8 +122,8 @@ sub smtp_close () { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub smtp_transaction ($$$$$$) { - my ($servers, $Header, $Body, $bcc, $part, $total) = @_; +sub smtp_transaction($$$$$$) { + my($servers, $Header, $Body, $bcc, $part, $total) = @_; my $rc; my $fatal_error = 0; @@ -181,9 +166,9 @@ sub smtp_transaction ($$$$$$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub smtp_transact_sub ($$$$$$$) { - my ($server, $server_list, $Header, $Body, $bcc, $part, $total) = @_; - my ($i, $rc, $fail, @fatal, $msg_size, $btype); +sub smtp_transact_sub($$$$$$$) { + my($server, $server_list, $Header, $Body, $bcc, $part, $total) = @_; + my($i, $rc, $fail, @fatal, $msg_size, $btype); return $rc if ($rc = smtp_open($server, $server_list, 1)); if ($ESMTP{'8BITMIME'} && $main::Has_8bit_body && !$main::do_conv_8to7) { $btype = ' BODY=8BIT'; @@ -199,7 +184,7 @@ sub smtp_transact_sub ($$$$$$$) { } return $rc if ($rc); $fail = 0; - my ($rec); + my($rec); for ($i = 0; $i <= $#main::Recipients; $i++) { $rec = $main::Recipients[$i]; if ($bcc) { @@ -210,7 +195,7 @@ sub smtp_transact_sub ($$$$$$$) { } else { $rc = &tcp_command(\*SMTPd, "RCPT TO:<$rec>", ''); } - my (@resp) = &command_response; + my(@resp) = &command_response; if ($rc) { push(@fatal, @resp); } @@ -223,7 +208,7 @@ sub smtp_transact_sub ($$$$$$$) { } else { $rc = &tcp_command(\*SMTPd, "RCPT TO:$rec", ''); } - my (@resp) = &command_response; + my(@resp) = &command_response; if ($rc) { push(@fatal, @resp); } @@ -252,7 +237,7 @@ sub smtp_transact_sub ($$$$$$$) { } select (SMTPd); $| = 1; select (STDOUT); return $rc if ($rc = &tcp_command(\*SMTPd, '.', '')); - my (@resp) = &command_response; + my(@resp) = &command_response; &log_action($Esmtp_flag ? 'esmtp' : 'smtp', &get_cur_server(), join(',', @main::Recipients), 'sent', @resp); $main::Info .= "Delivery successful for the following recipient(s):\n"; @@ -276,9 +261,9 @@ sub smtp_transact_sub ($$$$$$$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub smtp_transaction_for_error_notify ($$$$) { - my ($server, $servers, $Header, $Body) = @_; - my ($rc, @prev_rcpt, @prev_stat); +sub smtp_transaction_for_error_notify($$$$) { + my($server, $servers, $Header, $Body) = @_; + my($rc, @prev_rcpt, @prev_stat); @prev_rcpt = @main::Recipients; @prev_stat = @Status; @main::Recipients = ($main::Sender); @@ -292,7 +277,7 @@ sub smtp_transaction_for_error_notify ($$$$) { $Esmtp_flag ? 'esmtp' : 'smtp', &get_cur_server, 1, &get_session_log); select (SMTPd); $| = 1; select (STDOUT); return $rc if ($rc = &tcp_command(\*SMTPd, '.', '')); - my (@resp) = &command_response; + my(@resp) = &command_response; &log_action($Esmtp_flag ? 'esmtp' : 'smtp', &get_cur_server(), join(',', @main::Recipients), 'sent', @resp); return 0; @@ -300,6 +285,35 @@ sub smtp_transaction_for_error_notify ($$$$) { 1; +__END__ + +=head1 NAME + +IM::Smtp - SMTP handler + +=head1 SYNOPSIS + + use IM::Smtp; + + $return_code = &smtp_open(current_server, server_list, log_flag); + $return_code = &smtp_close(socket, savehist_flag); + $return_code = &smtp_transaction(bcc_flag, part_current, part_total); + $return_code = &smtp_transaction_for_error_notify; + +=head1 DESCRIPTION + +The I<IM::Smtp> module handles SMTP. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Ssh.pm b/img/dist/IM/IM/Ssh.pm index bcac3f39..404a8f78 100644 --- a/img/dist/IM/IM/Ssh.pm +++ b/img/dist/IM/IM/Ssh.pm @@ -4,46 +4,47 @@ ### Ssh.pm ### ### Author: Masatoshi Tsuchiya <tsuchiya@pine.kuee.kyoto-u.ac.jp> +### Internet Message Group <img@mew.org> ### Created: Oct 05, 1999 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Ssh.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Ssh.pm version 20021207(IM142)"; package IM::Ssh; require 5.003; require Exporter; -use IM::Config qw( connect_timeout command_timeout $SSH_PATH ); +use IM::Config qw(connect_timeout command_timeout $SSH_PATH); use IM::Util; use strict; -use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $SSH $FH @PID ); -@ISA = qw( Exporter ); -@EXPORT = qw( ssh_proxy ); +use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $SSH $FH @PID); +@ISA = qw(Exporter); +@EXPORT = qw(ssh_proxy); # Global Variables $FH = "SSH00000"; @PID = (); -sub ssh_proxy ($$$$) { - my( $server, $remote, $local, $host ) = @_; +sub ssh_proxy($$$$) { + my($server, $remote, $local, $host) = @_; - unless( $host ){ - im_err( "Missing relay host.\n" ); + unless ($host) { + im_err("Missing relay host.\n"); return 0; } - im_notice( "openning SSH-tunnel to $server/$remote\%$local via $host\n" ) + im_notice("openning SSH-tunnel to $server/$remote\%$local via $host\n") if &verbose; - my( $pid, $read, $write ); + my($pid, $read, $write); FORK: { no strict 'refs'; $read = $FH++; $write = $FH++; - pipe( $read, $write ); - if ( $pid = fork ) { + pipe($read, $write); + if ($pid = fork) { close $write; - my( $buf, $sig, $i ); - for( $i=0; $i<3; $i++ ){ + my($buf, $sig, $i); + for ($i=0; $i<3; $i++) { $sig = $SIG{ALRM}; $SIG{ALRM} = sub { die "SIGALRM is received\n"; }; eval { @@ -52,34 +53,35 @@ sub ssh_proxy ($$$$) { alarm 0; }; $SIG{ALRM} = $sig; - if ( $@ !~ /SIGALRM is received/ ) { - push( @PID, $pid ); - if ( $buf =~ /ssh_proxy_connect/ ) { + if ($@ !~ /SIGALRM is received/) { + push(@PID, $pid); + if ($buf =~ /ssh_proxy_connect/) { return $local; - } elsif ( $buf =~ /Local: bind: Address already in use/ ) { + } elsif ($buf =~ /Local: bind: Address already in use/) { $local++; redo FORK; - } elsif( $buf ){ + } elsif ($buf) { last; } } } $buf =~ s/\s+$//; $buf =~ s/\n/\\n/g; - im_warn( "Accident in Port Forwading: $buf\n" ); - } elsif ( $pid == 0 ) { + im_warn("Accident in Port Forwading: $buf\n"); + } elsif ($pid == 0) { close $read; - open(STDOUT, ">&$write" ); - open(STDERR, ">&$write" ); + open(STDOUT, ">&$write"); + open(STDERR, ">&$write"); exec($SSH_PATH, '-n', '-x', '-o', 'BatchMode yes', - "-L$local:$server:$remote", $host, - sprintf( 'echo ssh_proxy_connect ; sleep %s', &command_timeout() ) ); + "-L$local:$server:$remote", $host, + sprintf('echo ssh_proxy_connect ; sleep %s', + &command_timeout())); exit 0; # Not reach. - } elsif ( $! =~ /No more process/ ) { + } elsif ($! =~ /No more process/) { sleep 5; redo FORK; } else { - im_warn( "Can't fork $SSH_PATH.\n" ); + im_warn("Can't fork $SSH_PATH.\n"); } } 0; @@ -87,12 +89,69 @@ sub ssh_proxy ($$$$) { sub END { - if ( @PID ) { + if (@PID) { kill 15, @PID; sleep 3; kill 9, @PID; } } - 1; + +__END__ + +=head1 NAME + +IM::Ssh - SSH handler + +=head1 SYNOPSIS + + use IM::Ssh; + + if ($remote = ssh_proxy($server, $remote, $local, $host)) { + # connection succeeded + } else { + # connection failed + } + +=head1 DESCRIPTION + +The I<IM::Ssh> module handles SSH. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + +### Copyright (C) 1997, 1998, 1999 IM developing team +### 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 team 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 TEAM 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 TEAM 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. diff --git a/img/dist/IM/IM/Stdio.pm b/img/dist/IM/IM/Stdio.pm index c247e6b1..7d4d9808 100644 --- a/img/dist/IM/IM/Stdio.pm +++ b/img/dist/IM/IM/Stdio.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: May 7, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Stdio.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Stdio.pm version 20021207(IM142)"; package IM::Stdio; require 5.003; @@ -22,7 +22,7 @@ use vars qw(@ISA @EXPORT $old); # why not my($old)? @ISA = qw(Exporter); @EXPORT = qw(flush); -sub flush (*) { +sub flush(*) { local($old) = select(shift); $| = 1; print ''; @@ -32,6 +32,37 @@ sub flush (*) { 1; +__END__ + +=head1 NAME + +IM::Stdio - stdio handler + +=head1 SYNOPSIS + + use IM::Stdio; + + flush(OUTPUT_HANDLE); + +=head1 DESCRIPTION + +The I<IM::Stdio> module handles stdio. + +This modules is provided by IM (Internet Message). + +=head1 BUGS + +This module is semi-obsolete. This module conflicts with the +I<IM::Util> module. + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/TcpTransaction.pm b/img/dist/IM/IM/TcpTransaction.pm index 389d47c6..63d6599c 100644 --- a/img/dist/IM/IM/TcpTransaction.pm +++ b/img/dist/IM/IM/TcpTransaction.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::TcpTransaction.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::TcpTransaction.pm version 20021207(IM142)"; package IM::TcpTransaction; require 5.003; @@ -31,21 +31,6 @@ use vars qw(@ISA @EXPORT); get_session_log set_cur_server get_cur_server get_cur_server_original_form pool_priv_sock); -=head1 NAME - -TcpTransaction - TCP Transaction processing interface for SMTP and NNTP - -=head1 SYNOPSIS - -$socket = &connect_server(server_list, protocol, log_flag); -$return_code = &tcp_command(socket, command_string, log_flag); -@response = &command_response; -&set_command_response(response_string_list); - -=head1 DESCRIPTION - -=cut - use vars qw($Cur_server $Cur_server_original_form $Session_log $TcpSockName $SOCK @Response $Logging @SockPool @Sock6Pool); BEGIN { @@ -54,7 +39,7 @@ BEGIN { $TcpSockName = 'tcp00'; } -sub log_transaction () { +sub log_transaction() { use IM::Log; } @@ -66,8 +51,8 @@ sub log_transaction () { # root: privilidge port required # return value: handle if success # -sub connect_server ($$$) { - my ($servers, $serv, $root) = @_; +sub connect_server($$$) { + my($servers, $serv, $root) = @_; if ($#$servers < 0) { im_err("no server specified for $serv\n"); @@ -77,14 +62,14 @@ sub connect_server ($$$) { $SIG{'ALRM'} = \&alarm_func; no strict 'refs'; # XXX - local (*SOCK) = \*{$TcpSockName}; + local(*SOCK) = \*{$TcpSockName}; $SOCK = $serv; @Response = (); - my (@he_infos); - my ($s, $localport, $remoteport); + my(@he_infos); + my($s, $localport, $remoteport); foreach $s (@$servers) { $Cur_server_original_form = $s; - my ($r) = ($#$servers >= 0) ? 'skipped' : 'failed'; + my($r) = ($#$servers >= 0) ? 'skipped' : 'failed'; # manage server[/remoteport]%localport if ($s =~ s/\%(\d+)$//) { $localport = $1; @@ -95,14 +80,14 @@ sub connect_server ($$$) { next unless ($remoteport = getserv($serv, 'tcp')); } if ($main::SSH_server eq 'localhost') { - im_warn( "Don't use port-forwarding to `localhost'.\n" ); + im_warn("Don't use port-forwarding to `localhost'.\n"); $Cur_server = "$s/$remoteport"; } else { - if ( $remoteport = &ssh_proxy($s,$remoteport,$localport,$main::SSH_server) ) { + if ($remoteport = &ssh_proxy($s,$remoteport,$localport,$main::SSH_server)) { $s = 'localhost'; $Cur_server = "$Cur_server%$remoteport"; } else { # Connection failed. - im_warn( "Can't login to $main::SSH_server\n" ); + im_warn("Can't login to $main::SSH_server\n"); if ($serv eq 'smtp') { &log_action($serv, $Cur_server, join(',', @main::Recipients), $r, @Response); @@ -138,7 +123,7 @@ sub connect_server ($$$) { next; } while ($#he_infos >= 0) { - my ($family, $socktype, $proto, $sin, $canonname) + my($family, $socktype, $proto, $sin, $canonname) = splice(@he_infos, 0, 5); if ($root && unixp()) { my $name = priv_sock($family); @@ -207,9 +192,9 @@ sub connect_server ($$$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub tcp_command ($$$) { - my ($CHAN, $command, $fake) = @_; - my ($resp, $stat, $rcode, $logcmd); +sub tcp_command($$$) { + my($CHAN, $command, $fake) = @_; + my($resp, $stat, $rcode, $logcmd); @Response = (); $stat = ''; @@ -266,9 +251,9 @@ sub tcp_command ($$$) { # send_command(channel, command, fake_message) # return value: the first line of responses # -sub send_command ($$$) { - my ($CHAN, $command, $fake) = @_; - my ($resp, $logcmd); +sub send_command($$$) { + my($CHAN, $command, $fake) = @_; + my($resp, $logcmd); if ($command) { print $CHAN "$command\r\n"; if ($fake) { @@ -299,9 +284,9 @@ sub send_command ($$$) { return $resp; } -sub send_data ($$$) { - my ($CHAN, $data, $fake) = @_; - my ($logdata); +sub send_data($$$) { + my($CHAN, $data, $fake) = @_; + my($logdata); $data =~ s/\r?\n?$//; print $CHAN "$data\r\n"; if ($fake) { @@ -313,7 +298,7 @@ sub send_data ($$$) { $Session_log .= "<<< $logdata\n" if ($Logging); } -sub next_response ($) { +sub next_response($) { my $CHAN = shift; my $resp; @@ -334,36 +319,36 @@ sub next_response ($) { return $resp; } -sub command_response () { +sub command_response() { return @Response; } -sub set_command_response (@) { +sub set_command_response(@) { @Response = @_; } -sub tcp_logging ($) { +sub tcp_logging($) { # conversations are saved in $Session_log if true $Logging = shift; } -sub get_session_log () { +sub get_session_log() { return $Session_log; } -sub set_cur_server ($) { +sub set_cur_server($) { $Cur_server = shift; } -sub get_cur_server () { +sub get_cur_server() { return $Cur_server; } -sub get_cur_server_original_form () { +sub get_cur_server_original_form() { return $Cur_server_original_form; } -sub pool_priv_sock ($) { +sub pool_priv_sock($) { my $count = shift; pool_priv_sock_af($count, AF_INET); @@ -373,12 +358,12 @@ sub pool_priv_sock ($) { } } -sub pool_priv_sock_af ($$) { - my ($count, $family) = @_; +sub pool_priv_sock_af($$) { + my($count, $family) = @_; my $privport = 1023; no strict 'refs'; # XXX - my ($pe_name, $pe_aliases, $pe_proto); + my($pe_name, $pe_aliases, $pe_proto); ($pe_name, $pe_aliases, $pe_proto) = getprotobyname ('tcp'); unless ($pe_name) { $pe_proto = 6; @@ -389,7 +374,7 @@ sub pool_priv_sock_af ($$) { return -1; } while ($privport > 0) { - my ($ANYADDR, $psin); + my($ANYADDR, $psin); im_debug("binding port $privport.\n") if (&debug('tcp')); if ($family == AF_INET) { @@ -419,9 +404,9 @@ sub pool_priv_sock_af ($$) { return 0; } -sub priv_sock ($) { - my ($family) = shift; - my ($sock_name); +sub priv_sock($) { + my($family) = shift; + my($sock_name); if ($family == AF_INET) { return '' if ($#SockPool < 0); @@ -438,12 +423,12 @@ sub alarm_func { im_die("connection error\n"); } -sub im_getaddrinfo ($$;$$$$) { +sub im_getaddrinfo($$;$$$$) { return getaddrinfo(@_) if (defined &getaddrinfo); - my ($node, $serv, $family, $socktype, $proto, $flags) = @_; + my($node, $serv, $family, $socktype, $proto, $flags) = @_; - my ($pe_name, $pe_aliases, $pe_proto, $se_port); + my($pe_name, $pe_aliases, $pe_proto, $se_port); if (unixp()) { $proto = 'tcp' unless ($proto); ($pe_name, $pe_aliases, $pe_proto) = getprotobyname($proto); @@ -451,7 +436,7 @@ sub im_getaddrinfo ($$;$$$$) { $pe_proto = 6 unless ($pe_name); return unless ($se_port = getserv($serv, $proto)); - my ($he_name, $he_alias, $he_type, $he_len, @he_addrs); + my($he_name, $he_alias, $he_type, $he_len, @he_addrs); if ($node =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { @he_addrs = (pack('C4', $1, $2, $3, $4)); } else { @@ -462,7 +447,7 @@ sub im_getaddrinfo ($$;$$$$) { return unless ($he_name); } - my ($he_addr, @infos); + my($he_addr, @infos); foreach $he_addr (@he_addrs) { push(@infos, AF_INET, $socktype, $pe_proto, pack_sockaddr_in($se_port, $he_addr), $he_name); @@ -471,13 +456,13 @@ sub im_getaddrinfo ($$;$$$$) { } sub getserv($$) { - my ($serv, $proto) = @_; + my($serv, $proto) = @_; - my ($se_port); + my($se_port); if ($serv =~ /^\d+$/o) { $se_port = $serv; } else { - my ($se_name, $se_aliases); + my($se_name, $se_aliases); ($se_name, $se_aliases, $se_port) = getservbyname($serv, $proto) if (unixp()); unless ($se_name) { @@ -502,6 +487,35 @@ sub getserv($$) { 1; +__END__ + +=head1 NAME + +IM::TcpTransaction - TCP transaction processing interface for SMTP and NNTP + +=head1 SYNOPSIS + + use IM::TcpTransaction; + + $socket = &connect_server(server_list, protocol, log_flag); + $return_code = &tcp_command(socket, command_string, log_flag); + @response = &command_response; + &set_command_response(response_string_list); + +=head1 DESCRIPTION + +The I<IM::TcpTransaction> module handles TCP transaction for SMTP and NNTP. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/IM/Util.pm b/img/dist/IM/IM/Util.pm index 8b9235ff..68da1a5e 100644 --- a/img/dist/IM/IM/Util.pm +++ b/img/dist/IM/IM/Util.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Util.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Util.pm version 20021207(IM142)"; package IM::Util; require 5.003; @@ -71,7 +71,7 @@ sub unixp { } sub win95p { - if (($OS eq 'WIN95') || ($OS eq 'WNT') ){ + if (($OS eq 'WIN95') || ($OS eq 'WNT')) { return 1; } else { return 0; @@ -94,14 +94,14 @@ sub os2p { } } -sub progname () { +sub progname() { return $main::Prog; } ### ### get login name ### -sub im_getlogin () { +sub im_getlogin() { if (&unixp()) { my $login = getlogin(); if ($login ne '' && $login ne 'root') { @@ -109,9 +109,9 @@ sub im_getlogin () { } else { return (getpwuid($<))[0] || undef; } - } elsif (&os2p()){ + } elsif (&os2p()) { return getlogin() || undef; - } elsif (&win95p()){ + } elsif (&win95p()) { return Win32::LoginName(); } } @@ -128,54 +128,54 @@ sub im_getlogin () { # im_err - display critical error messages -- process will be aborted # im_die - display critical error messages and exit -sub im_msg ($) { +sub im_msg($) { my $msg = shift; print progname(), ': ', $msg; } -sub im_info ($) { +sub im_info($) { my $info = shift; return if $main::opt_quiet; print progname(), ': ', $info; } -sub im_debug ($) { +sub im_debug($) { my $dbg = shift; print STDERR progname(), ':DEBUG: ', $dbg; } -sub im_notice ($) { +sub im_notice($) { return unless &verbose; my $warn = progname() . ': '. shift; $SavedMsg .= $warn; print STDERR $warn; } -sub im_warn ($) { +sub im_warn($) { my $warn = progname() . ': '. shift; $SavedMsg .= $warn; print STDERR $warn; } -sub im_err ($) { +sub im_err($) { my $err = progname() . ': ERROR: ' . shift; $SavedMsg .= $err; print STDERR $err; } -sub im_die ($) { +sub im_die($) { my $die = shift; print STDERR progname(), ': ERROR: ', $die; exit $EXIT_ERROR; } -sub im_die2 ($) { +sub im_die2($) { my $die = shift; print STDERR progname(), ': ', $die; exit $EXIT_ERROR; } -sub im_save_error (;$) { +sub im_save_error(;$) { my $string = shift; if ($string eq '') { $SavedMsg = ''; # reset @@ -184,7 +184,7 @@ sub im_save_error (;$) { } } -sub im_saved_errors () { +sub im_saved_errors() { return $SavedMsg; } @@ -192,22 +192,21 @@ sub im_saved_errors () { ### Debug ### -sub print_hash (\%) -{ +sub print_hash(\%) { my $hashref = shift; - foreach (keys(%{$hashref})){ + foreach (keys(%{$hashref})) { print "$_ -> $hashref->{$_}\n"; } } -sub set_debug ($$) { +sub set_debug($$) { my $category = shift; $Debug{$category} = shift; } -sub debug ($) { +sub debug($) { my $category = shift; if ($Debug{'all'}) { @@ -217,11 +216,11 @@ sub debug ($) { } } -sub set_verbose ($) { +sub set_verbose($) { $main::opt_verbose = shift; } -sub verbose () { +sub verbose() { return $main::opt_verbose; } @@ -229,7 +228,7 @@ sub verbose () { # # debug_option() # -sub debug_option ($) { +sub debug_option($) { my $DebugFlag = shift; if ($DebugFlag && ($DebugFlag !~ /^(off|no|false|0)$/)) { @@ -245,7 +244,7 @@ sub debug_option ($) { # flush buffer # -sub flush (*) { +sub flush(*) { local($old) = select(shift); $| = 1; print ''; @@ -258,8 +257,8 @@ sub flush (*) { # sub im_open($$) { - my ($d, $a) = @_; - my ($r); + my($d, $a) = @_; + my($r); if ($r = open($d, $a)) { binmode($d); } @@ -267,8 +266,8 @@ sub im_open($$) { } sub im_sysopen($$$) { - my ($d, $f, $a) = @_; - my ($r); + my($d, $f, $a) = @_; + my($r); if ($r = sysopen($d, $f, $a)) { binmode($d); } @@ -277,6 +276,45 @@ sub im_sysopen($$$) { 1; +__END__ + +=head1 NAME + +IM::Util - utility functions for IM + +=head1 SYNOPSIS + + use IM::Util; + +Constant variables: +$SUCCESS +$ERROR +$EXIT_SUCCESS +$EXIT_ERROR + +Subroutines: +unixp win95p wntp os2p +progname +im_getlogin +im_msg im_info im_debug im_notice im_warn im_err im_die im_die2 +im_save_error im_saved_errors im_open im_sysopen +debug_option set_debug debug set_verbose verbose +flush + +=head1 DESCRIPTION + +The I<IM::Util> module provides utility functions for IM. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/Makefile.PL b/img/dist/IM/Makefile.PL index adf82e11..9fd61227 100644 --- a/img/dist/IM/Makefile.PL +++ b/img/dist/IM/Makefile.PL @@ -2,7 +2,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Nov 12, 2002 ### ### perl Makefile.PL ### make @@ -33,7 +33,7 @@ if (open(CONFIN, "configure.in")) { close(CONFIN); } -if ($Config{'osname'} ne 'MSWin32'){ +if ($Config{'osname'} ne 'MSWin32') { $prefix = "/usr/local"; $libdir = "\$exec_prefix/lib"; } else { @@ -134,9 +134,9 @@ WriteMakefile( # special rules sub MY::postamble { - my ($self) = shift; - my (@m); - if ($Config{'osname'} ne 'MSWin32'){ + my($self) = shift; + my(@m); + if ($Config{'osname'} ne 'MSWin32') { push (@m, qq{ prefix=$prefix exec_prefix=$prefix diff --git a/img/dist/IM/Makefile.in b/img/dist/IM/Makefile.in index a1353e5a..b40bfe2b 100644 --- a/img/dist/IM/Makefile.in +++ b/img/dist/IM/Makefile.in @@ -4,7 +4,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Nov 16, 2002 ### SHELL= /bin/sh @@ -35,12 +35,15 @@ moddir= $(perldir)/IM RPOP= @im_rpop@ -PROG = imali imcat imcd imclean imgrep imhist imhsync imjoin imls immv \ - impack impath imput impwagent imrm imsetup imsort imstore \ - imtar immknmz +PROG = imali imcat imcd imclean \ + imgrep imhist imhsync imjoin imls \ + immknmz immv impack impath imput \ + impwagent imrm imsetup imsort imstore imtar ALLPROG = $(PROG) imget +CNF = config.h config.status config.cache config.log configure.lineno + all: @echo everything has been done by configure. @echo you only need to do "make install". @@ -86,7 +89,7 @@ clean:: $(rm) -f IM/Config.pm distclean:: clean - $(rm) -f Makefile config.log config.status config.cache + $(rm) -f Makefile $(CNF) ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. diff --git a/img/dist/IM/OS2/00readme b/img/dist/IM/OS2/00readme index 4b164ecf..8e03e7a1 100644 --- a/img/dist/IM/OS2/00readme +++ b/img/dist/IM/OS2/00readme @@ -6,6 +6,10 @@ Sep 07, 1998 + Modified by Tatsuya Kinoshita on Dec 7, 2002 +OS2 support is outdated. Last update: Sep 23, 1998 (IM101). + + * Install Perl 5.004_03 if not installed. !!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!! diff --git a/img/dist/IM/cnf.im/SiteConfig.in b/img/dist/IM/cnf.im/SiteConfig.in index 94e380eb..74adaad9 100644 --- a/img/dist/IM/cnf.im/SiteConfig.in +++ b/img/dist/IM/cnf.im/SiteConfig.in @@ -103,6 +103,7 @@ ToDomain=@im_hostname@ # domain when domain part is omitted #Imget.Src=local:${HOME}/Maildir # in case of qmail UseCL=@im_usecl@ # Use value of Content-Length header NoSync=@im_nosync@ # Do not need fsync(2) on writing file +#FsyncNumber=118 # system call number of fsync #Imget.Src=pop #PopAccount=/APOP@localhost # account info for POP access @@ -119,14 +120,19 @@ NoSync=@im_nosync@ # Do not need fsync(2) on writing file #HttpProxy=proxy-server:8080 # proxy server for HTTP access #NoProxy=http://.*my.domain/ # URL regex not to use Proxy server #UsePwAgent=yes # use password agent -#PwAgentPort=6543 # Port to connect pwagent with TCP/IP - # (Insecure for multi-user system!) - # 0 to use UNIX domain socket (more secure) +#PwAgentPort=0 # Port to connect pwagent with TCP/IP + # 0 to use UNIX domain socket + # NOTE: non-0 (e.g. 6543) is insecure + # on multi-user system +#PwAgentTmpDir=pwagtmp # temporary directory (relative to ~/.im/) # be careful on security if you wish to use PwFiles! #UsePwFiles=yes # use password files #PwFiles=password # password files (relative to ~/.im/) +#NamazuV2=yes # use Namazu version 2 (1.9.x or late) +#NamazuLockDir=nmzlock # lock directory (relative to ~/.im/) + ## imput specific #FccDir=$MailDir # directory for FCC folders #QueueDir=queue # directory for to store messages to be sent diff --git a/img/dist/IM/configure b/img/dist/IM/configure index 4aa36c5d..a6809c77 100755 --- a/img/dist/IM/configure +++ b/img/dist/IM/configure @@ -12,11 +12,15 @@ ac_help= ac_default_prefix=/usr/local # Any additions from configure.in: ac_help="$ac_help - --enable-rpop Use RPOP (suidperl is needed)" + --enable-rpop Use RPOP (suidperl is needed)" ac_help="$ac_help - --with-perldir=DIR Use DIR as site_perl directory" + --with-fsyncno=NUMBER Use NUMBER as SYS_fsync" ac_help="$ac_help - --with-ssh=PATH Use PATH as SSH location" + --with-perldir=DIR Use DIR as site_perl directory" +ac_help="$ac_help + --with-ssh=PATH Use PATH as SSH location" +ac_help="$ac_help + --with-hostname=HOSTNAME Use HOSTNAME as default domain for mail-address" # Initialize some variables set by options. # The variables have the same names as the options, with @@ -559,7 +563,7 @@ ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 -echo "configure:563: checking for a BSD compatible install" >&5 +echo "configure:567: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -618,7 +622,7 @@ else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; } fi echo $ac_n "checking host system type""... $ac_c" 1>&6 -echo "configure:622: checking host system type" >&5 +echo "configure:626: checking host system type" >&5 host_alias=$host case "$host_alias" in @@ -641,7 +645,7 @@ echo "$ac_t""$host" 1>&6 # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:645: checking for $ac_word" >&5 +echo "configure:649: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -671,7 +675,7 @@ if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:675: checking for $ac_word" >&5 +echo "configure:679: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -722,7 +726,7 @@ fi # Extract the first word of "cl", so it can be a program name with args. set dummy cl; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:726: checking for $ac_word" >&5 +echo "configure:730: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -754,7 +758,7 @@ fi fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:758: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:762: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. @@ -765,12 +769,12 @@ cross_compiling=$ac_cv_prog_cc_cross cat > conftest.$ac_ext << EOF -#line 769 "configure" +#line 773 "configure" #include "confdefs.h" main(){return(0);} EOF -if { (eval echo configure:774: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:778: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -796,12 +800,12 @@ if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:800: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:804: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:805: checking whether we are using GNU C" >&5 +echo "configure:809: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -810,7 +814,7 @@ else yes; #endif EOF -if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:814: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:818: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -829,7 +833,7 @@ ac_test_CFLAGS="${CFLAGS+set}" ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:833: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:837: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -861,7 +865,7 @@ else fi echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:865: checking how to run the C preprocessor" >&5 +echo "configure:869: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= @@ -876,13 +880,13 @@ else # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext <<EOF -#line 880 "configure" +#line 884 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:886: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:890: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -893,13 +897,13 @@ else rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext <<EOF -#line 897 "configure" +#line 901 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:903: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:907: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -910,13 +914,13 @@ else rm -rf conftest* CPP="${CC-cc} -nologo -E" cat > conftest.$ac_ext <<EOF -#line 914 "configure" +#line 918 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:920: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:924: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -959,7 +963,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:963: checking for $ac_word" >&5 +echo "configure:967: checking for $ac_word" >&5 if eval "test \"`echo '$''{'im_cv_path_im_path_perl'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1000,7 +1004,7 @@ case "$im_path_perl" in exit 1 esac echo $ac_n "checking for site_perl""... $ac_c" 1>&6 -echo "configure:1004: checking for site_perl" >&5 +echo "configure:1008: checking for site_perl" >&5 if eval "test \"`echo '$''{'im_cv_path_im_path_siteperl'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1026,7 +1030,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1030: checking for $ac_word" >&5 +echo "configure:1034: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_im_path_chmod'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1067,7 +1071,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1071: checking for $ac_word" >&5 +echo "configure:1075: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_im_path_mkdir'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1108,7 +1112,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1112: checking for $ac_word" >&5 +echo "configure:1116: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_im_path_rm'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1149,7 +1153,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1153: checking for $ac_word" >&5 +echo "configure:1157: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_im_path_mv'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1190,7 +1194,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1194: checking for $ac_word" >&5 +echo "configure:1198: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_im_path_sed'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1227,7 +1231,7 @@ done test -n "$im_path_sed" || im_path_sed="missing_sed" echo $ac_n "checking for DB type""... $ac_c" 1>&6 -echo "configure:1231: checking for DB type" >&5 +echo "configure:1235: checking for DB type" >&5 if eval "test \"`echo '$''{'im_cv_perl_im_db_type'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1252,26 +1256,34 @@ fi # Check whether --enable-rpop or --disable-rpop was given. if test "${enable_rpop+set}" = set; then enableval="$enable_rpop" - im_rpop="-o root -m 4555" + im_rpop="-o root -m 4755" else - im_rpop="-m 555" + im_rpop="-m 755" fi -im_nosync="undefined" -ac_safe=`echo "sys/syscall.h" | sed 'y%./+-%__p_%'` +im_fsync_no=undef +# Check whether --with-fsyncno or --without-fsyncno was given. +if test "${with_fsyncno+set}" = set; then + withval="$with_fsyncno" + im_fsync_no="${withval}" +fi + +if test "x$im_fsync_no" = 'xundef'; then + im_nosync="undefined" + ac_safe=`echo "sys/syscall.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/syscall.h""... $ac_c" 1>&6 -echo "configure:1265: checking for sys/syscall.h" >&5 +echo "configure:1277: checking for sys/syscall.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1270 "configure" +#line 1282 "configure" #include "confdefs.h" #include <sys/syscall.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1275: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1287: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -1292,8 +1304,8 @@ else echo "$ac_t""no" 1>&6 fi -if test "$ac_cv_header_sys_syscall_h" = yes ; then - cat > conftest.c << EOF + if test "$ac_cv_header_sys_syscall_h" = yes ; then + cat > conftest.c << EOF #include <sys/syscall.h> #ifdef SYS_fsync IM_FSYNC_NO=SYS_fsync @@ -1301,13 +1313,11 @@ IM_FSYNC_NO=SYS_fsync IM_FSYNC_NO=undef #endif EOF - - im_fsync_no=`eval $ac_cpp conftest.c | sed -n -e "s/^IM_FSYNC_NO=//p"` - rm -f conftest.c -else - im_fsync_no=undef + im_fsync_no=`eval $ac_cpp conftest.c | sed -n -e "s/^IM_FSYNC_NO=//p"` + rm -f conftest.c + fi fi -if test "x$im_fsync_no" = "xundef"; then +if test "x$im_fsync_no" = 'xundef'; then im_nosync="yes" else im_nosync="no" @@ -1328,7 +1338,7 @@ fi echo $ac_n "checking OS type""... $ac_c" 1>&6 -echo "configure:1332: checking OS type" >&5 +echo "configure:1342: checking OS type" >&5 case "$host" in *-*-solaris2*) echo "$ac_t""Seems to be a Solaris; Content-Length: should be checked" 1>&6 @@ -1338,18 +1348,18 @@ case "$host" in im_usecl=no ;; esac -im_path_ssh='yes' +im_path_ssh='' # Check whether --with-ssh or --without-ssh was given. if test "${with_ssh+set}" = set; then withval="$with_ssh" im_path_ssh="${withval}" fi -if test "x$im_path_ssh" = 'xyes'; then - # Extract the first word of "ssh", so it can be a program name with args. +if test "x$im_path_ssh" = 'x'; then + # Extract the first word of "ssh", so it can be a program name with args. set dummy ssh; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1353: checking for $ac_word" >&5 +echo "configure:1363: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_im_path_ssh'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1384,10 +1394,19 @@ fi fi -echo $ac_n "checking domain for mail-address""... $ac_c" 1>&6 -echo "configure:1389: checking domain for mail-address" >&5 -im_hostname=`hostname` -echo "$ac_t""$im_hostname" 1>&6 +im_hostname='' +# Check whether --with-hostname or --without-hostname was given. +if test "${with_hostname+set}" = set; then + withval="$with_hostname" + im_hostname="${withval}" +fi + +if test "x$im_hostname" = 'x'; then + echo $ac_n "checking domain for mail-address""... $ac_c" 1>&6 +echo "configure:1407: checking domain for mail-address" >&5 + im_hostname=`hostname` + echo "$ac_t""$im_hostname" 1>&6 +fi trap '' 1 2 15 cat > confcache <<\EOF @@ -1502,14 +1521,14 @@ done ac_given_srcdir=$srcdir ac_given_INSTALL="$INSTALL" -trap 'rm -fr `echo "imali:imali.in imcat:imcat.in imcd:imcd.in imclean:imclean.in \ - imget:imget.in imgrep:imgrep.in \ - imhist:imhist.in imhsync:imhsync.in \ - imjoin:imjoin.in imls:imls.in immv:immv.in \ - impack:impack.in impath:impath.in imput:imput.in \ - impwagent:impwagent.in \ - imrm:imrm.in imsetup:imsetup.in imsort:imsort.in \ - imstore:imstore.in imtar:imtar.in immknmz:immknmz.in\ +trap 'rm -fr `echo "imali:imali.in imcat:imcat.in imcd:imcd.in \ + imclean:imclean.in imget:imget.in \ + imgrep:imgrep.in imhist:imhist.in imhsync:imhsync.in \ + imjoin:imjoin.in imls:imls.in \ + immknmz:immknmz.in immv:immv.in impack:impack.in \ + impath:impath.in imput:imput.in \ + impwagent:impwagent.in imrm:imrm.in imsetup:imsetup.in \ + imsort:imsort.in imstore:imstore.in imtar:imtar.in \ Makefile:Makefile.in \ cnf.im/SiteConfig:cnf.im/SiteConfig.in \ IM/Config.pm:IM/Config.pm.in \ @@ -1613,14 +1632,14 @@ EOF cat >> $CONFIG_STATUS <<EOF -CONFIG_FILES=\${CONFIG_FILES-"imali:imali.in imcat:imcat.in imcd:imcd.in imclean:imclean.in \ - imget:imget.in imgrep:imgrep.in \ - imhist:imhist.in imhsync:imhsync.in \ - imjoin:imjoin.in imls:imls.in immv:immv.in \ - impack:impack.in impath:impath.in imput:imput.in \ - impwagent:impwagent.in \ - imrm:imrm.in imsetup:imsetup.in imsort:imsort.in \ - imstore:imstore.in imtar:imtar.in immknmz:immknmz.in\ +CONFIG_FILES=\${CONFIG_FILES-"imali:imali.in imcat:imcat.in imcd:imcd.in \ + imclean:imclean.in imget:imget.in \ + imgrep:imgrep.in imhist:imhist.in imhsync:imhsync.in \ + imjoin:imjoin.in imls:imls.in \ + immknmz:immknmz.in immv:immv.in impack:impack.in \ + impath:impath.in imput:imput.in \ + impwagent:impwagent.in imrm:imrm.in imsetup:imsetup.in \ + imsort:imsort.in imstore:imstore.in imtar:imtar.in \ Makefile:Makefile.in \ cnf.im/SiteConfig:cnf.im/SiteConfig.in \ IM/Config.pm:IM/Config.pm.in \ @@ -1688,9 +1707,10 @@ cat >> $CONFIG_STATUS <<EOF EOF cat >> $CONFIG_STATUS <<\EOF -chmod 555 imali imcat imcd imclean imget imgrep imhist imjoin\ - imls immv impack impath imput impwagent imrm imsetup imsort imstore\ - imtar +chmod 755 imali imcat imcd imclean imget \ + imgrep imhist imhsync imjoin imls \ + immknmz immv impack impath imput \ + impwagent imrm imsetup imsort imstore imtar exit 0 EOF chmod +x $CONFIG_STATUS diff --git a/img/dist/IM/configure.in b/img/dist/IM/configure.in index 85d03307..74a885d3 100644 --- a/img/dist/IM/configure.in +++ b/img/dist/IM/configure.in @@ -3,7 +3,7 @@ dnl configure.in dnl dnl Author: Internet Message Group <img@mew.org> dnl Created: Apr 23, 1997 -dnl Revised: Sep 3, 1998 +dnl Revised: Nov 16, 2002 dnl AC_INIT(imget.in) @@ -50,15 +50,20 @@ dnl Checks for typedefs, structures, and compiler characteristics. dnl Checks for library functions. AC_ARG_ENABLE(rpop, -[ --enable-rpop Use RPOP (suidperl is needed)], -[im_rpop="-o root -m 4555"], -[im_rpop="-m 555"],) - -dnl check fsync() is in sys/syscall.h -im_nosync="undefined" -AC_CHECK_HEADER(sys/syscall.h) -if test "$ac_cv_header_sys_syscall_h" = yes ; then - cat > conftest.c << EOF +[ --enable-rpop Use RPOP (suidperl is needed)], +[im_rpop="-o root -m 4755"], +[im_rpop="-m 755"],) + +im_fsync_no=undef +AC_ARG_WITH(fsyncno, +[ --with-fsyncno=NUMBER Use NUMBER as SYS_fsync], +[im_fsync_no="${withval}"]) +if test "x$im_fsync_no" = 'xundef'; then + dnl check fsync() is in sys/syscall.h + im_nosync="undefined" + AC_CHECK_HEADER(sys/syscall.h) + if test "$ac_cv_header_sys_syscall_h" = yes ; then + cat > conftest.c << EOF #include <sys/syscall.h> #ifdef SYS_fsync IM_FSYNC_NO=SYS_fsync @@ -66,13 +71,11 @@ IM_FSYNC_NO=SYS_fsync IM_FSYNC_NO=undef #endif EOF - - im_fsync_no=`eval $ac_cpp conftest.c | sed -n -e "s/^IM_FSYNC_NO=//p"` - rm -f conftest.c -else - im_fsync_no=undef + im_fsync_no=`eval $ac_cpp conftest.c | sed -n -e "s/^IM_FSYNC_NO=//p"` + rm -f conftest.c + fi fi -if test "x$im_fsync_no" = "xundef"; then +if test "x$im_fsync_no" = 'xundef'; then im_nosync="yes" else im_nosync="no" @@ -80,7 +83,7 @@ fi im_src_siteperl="use lib '`pwd`'; ###DELETE-ON-INSTALL###" AC_ARG_WITH(perldir, -[ --with-perldir=DIR Use DIR as site_perl directory], +[ --with-perldir=DIR Use DIR as site_perl directory], [im_path_siteperl="${withval}" im_my_siteperl="use lib '${withval}';"], [if test "${prefix}" != "NONE" ; then @@ -99,32 +102,39 @@ case "$host" in im_usecl=no ;; esac -im_path_ssh='yes' +im_path_ssh='' AC_ARG_WITH(ssh, -[ --with-ssh=PATH Use PATH as SSH location], +[ --with-ssh=PATH Use PATH as SSH location], [im_path_ssh="${withval}"]) -if test "x$im_path_ssh" = 'xyes'; then - AC_PATH_PROG(im_path_ssh, ssh, '/usr/local/bin/ssh') +if test "x$im_path_ssh" = 'x'; then + AC_PATH_PROG(im_path_ssh, ssh, '/usr/local/bin/ssh') +fi + +im_hostname='' +AC_ARG_WITH(hostname, +[ --with-hostname=HOSTNAME Use HOSTNAME as default domain for mail-address], +[im_hostname="${withval}"]) +if test "x$im_hostname" = 'x'; then + AC_MSG_CHECKING([domain for mail-address]) + im_hostname=`hostname` + AC_MSG_RESULT([$im_hostname]) fi -AC_MSG_CHECKING([domain for mail-address]) -im_hostname=`hostname` -AC_MSG_RESULT([$im_hostname]) - -AC_OUTPUT(imali:imali.in imcat:imcat.in imcd:imcd.in imclean:imclean.in \ - imget:imget.in imgrep:imgrep.in \ - imhist:imhist.in imhsync:imhsync.in \ - imjoin:imjoin.in imls:imls.in immv:immv.in \ - impack:impack.in impath:impath.in imput:imput.in \ - impwagent:impwagent.in \ - imrm:imrm.in imsetup:imsetup.in imsort:imsort.in \ - imstore:imstore.in imtar:imtar.in immknmz:immknmz.in\ +AC_OUTPUT(imali:imali.in imcat:imcat.in imcd:imcd.in \ + imclean:imclean.in imget:imget.in \ + imgrep:imgrep.in imhist:imhist.in imhsync:imhsync.in \ + imjoin:imjoin.in imls:imls.in \ + immknmz:immknmz.in immv:immv.in impack:impack.in \ + impath:impath.in imput:imput.in \ + impwagent:impwagent.in imrm:imrm.in imsetup:imsetup.in \ + imsort:imsort.in imstore:imstore.in imtar:imtar.in \ Makefile:Makefile.in \ cnf.im/SiteConfig:cnf.im/SiteConfig.in \ IM/Config.pm:IM/Config.pm.in \ - , chmod 555 imali imcat imcd imclean imget imgrep imhist imjoin\ - imls immv impack impath imput impwagent imrm imsetup imsort imstore\ - imtar) + , chmod 755 imali imcat imcd imclean imget \ + imgrep imhist imhsync imjoin imls \ + immknmz immv impack impath imput \ + impwagent imrm imsetup imsort imstore imtar) dnl Copyright (C) 1997, 1998, 1999 IM developing team. dnl All rights reserved. diff --git a/img/dist/IM/dot.im/Config b/img/dist/IM/dot.im/Config index 3ab05031..86ac62c6 100644 --- a/img/dist/IM/dot.im/Config +++ b/img/dist/IM/dot.im/Config @@ -108,6 +108,7 @@ ToDomain=_domain_when_domain_part_is_omitted_ #Imget.Src=local:${HOME}/Maildir # in case of qmail #UseCL=no # Use value of Content-Length header #NoSync=no # Do not need fsync(2) on writing file +#FsyncNumber=118 # system call number of fsync #Imget.Src=pop #PopAccount=/APOP@localhost # account info for POP access @@ -124,14 +125,19 @@ ToDomain=_domain_when_domain_part_is_omitted_ #HttpProxy=proxy-server:8080 # proxy server for HTTP access #NoProxy=http://.*my.domain/ # URL regex not to use Proxy server #UsePwAgent=yes # use password agent -#PwAgentPort=6543 # Port to connect pwagent with TCP/IP - # (Insecure for multi-user system!) - # 0 to use UNIX domain socket (more secure) +#PwAgentPort=0 # Port to connect pwagent with TCP/IP + # 0 to use UNIX domain socket + # NOTE: non-0 (e.g. 6543) is insecure + # on multi-user system +#PwAgentTmpDir=pwagtmp # temporary directory (relative to ~/.im/) # be careful on security if you wish to use PwFiles! #UsePwFiles=yes # use password files #PwFiles=password # password files (relative to ~/.im/) +#NamazuV2=yes # use Namazu version 2 (1.9.x or late) +#NamazuLockDir=nmzlock # lock directory (relative to ~/.im/) + ## imput specific #FccDir=$MailDir # directory for FCC folders #QueueDir=queue # directory for to store messages to be sent diff --git a/img/dist/IM/dot.im/get.sbr b/img/dist/IM/dot.im/get.sbr index 15a3194a..3943631e 100644 --- a/img/dist/IM/dot.im/get.sbr +++ b/img/dist/IM/dot.im/get.sbr @@ -8,10 +8,10 @@ %hash = (); sub get_sub ($$$) { - my ($folder, $first, $last) = @_; + my($folder, $first, $last) = @_; my $dir = expand_path($folder); - my ($name, $val); + my($name, $val); open(SEQ, "$dir/.mh_sequences") || return; diff --git a/img/dist/IM/dot.im/getchk.sbr b/img/dist/IM/dot.im/getchk.sbr index decd6d5c..ea5b266b 100644 --- a/img/dist/IM/dot.im/getchk.sbr +++ b/img/dist/IM/dot.im/getchk.sbr @@ -1,7 +1,7 @@ # get messages sent to me directly sub getchk_sub { - local ($href) = shift; + local($href) = shift; # if (my_addr($href->{'to'}, $href->{'cc'}) { if ($href->{'to'} =~ /motonori/i || $href->{'cc'} =~ /motonori/i) { diff --git a/img/dist/IM/dot.im/getchk.sbr.postpet b/img/dist/IM/dot.im/getchk.sbr.postpet index d4818d94..a293a36b 100644 --- a/img/dist/IM/dot.im/getchk.sbr.postpet +++ b/img/dist/IM/dot.im/getchk.sbr.postpet @@ -1,7 +1,7 @@ # do not get messages from PostPet sub getchk_sub { - local ($href) = shift; + local($href) = shift; if ($href->{'x-mailer'} =~ /PostPet/i && $href->{'content-type'} =~ /multipart.+kiritorisen/i) { diff --git a/img/dist/IM/dot.im/scan.sbr b/img/dist/IM/dot.im/scan.sbr index 7fd83a11..86fb0261 100644 --- a/img/dist/IM/dot.im/scan.sbr +++ b/img/dist/IM/dot.im/scan.sbr @@ -12,7 +12,7 @@ $symbol_table{'{from}'} = 'fromaddr:'; # can be referenced with %{from} in Form #$REF_SYMBOL{'from:'} = 1; sub scan_sub { - local ($href) = shift; + local($href) = shift; # annotation mark if ($href->{'replied'} ne '') { diff --git a/img/dist/IM/dot.im/scan.sbr.sample1 b/img/dist/IM/dot.im/scan.sbr.sample1 index 126f64ba..eec5fc6e 100644 --- a/img/dist/IM/dot.im/scan.sbr.sample1 +++ b/img/dist/IM/dot.im/scan.sbr.sample1 @@ -2,7 +2,7 @@ $symbol_table{'W'} = 'wdate:'; $NEEDSAFE_HASH{'wdate:'} = 1; # if the field contains JIS characters sub scan_sub { - local ($href) = shift; + local($href) = shift; if (${$href}{'date'} =~ /([A-Z][a-z][a-z]), /) { if ($+ eq 'Mon') { diff --git a/img/dist/IM/dot.im/scan.sbr.sample2 b/img/dist/IM/dot.im/scan.sbr.sample2 index 6f54ad0b..fa99ef0d 100644 --- a/img/dist/IM/dot.im/scan.sbr.sample2 +++ b/img/dist/IM/dot.im/scan.sbr.sample2 @@ -6,7 +6,7 @@ ); sub scan_sub { - local ($href) = shift; + local($href) = shift; my($folder, $pattern); my($eval_string); diff --git a/img/dist/IM/imali.in b/img/dist/IM/imali.in index 89c8defc..73dea8b3 100644 --- a/img/dist/IM/imali.in +++ b/img/dist/IM/imali.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imali version 20000414(IM141)"; +my $VERSION = "imali version 20021207(IM142)"; $Prog = 'imali'; @@ -34,11 +34,10 @@ use vars qw($Prog $EXPLANATION @OptConfig ## Environments ## -$EXPLANATION = " -$Prog :: Internet Message Query Alias -$VERSION +$EXPLANATION = "$VERSION +display aliases for mail/news address -Usage: $Prog [options] [target...] +Usage: $Prog [OPTIONS] [TARGETS ...] "; @OptConfig = ( @@ -73,7 +72,7 @@ if (! $opt_host) { if (scalar(@targets) == 0) { alias_print(); } else { - my ($alias, $addr); + my($alias, $addr); foreach $alias (@targets) { $addr = alias_lookup($alias); if ($addr) { @@ -88,7 +87,7 @@ if (! $opt_host) { if (scalar(@targets) == 0) { hosts_print(); } else { - my ($alias, $host); + my($alias, $host); foreach $alias (@targets) { $host = hosts_lookup($alias); if ($host) { @@ -106,41 +105,57 @@ __END__ =head1 NAME -imali - Display mail aliases +imali - display aliases for mail/news address =head1 SYNOPSIS -B<imali> [B<--file=file>] [B<--verbose>] [B<--debug>] [B<--help>] [targets ...] +B<imali> [OPTIONS] [TARGETS ...] =head1 DESCRIPTION -I<Imali> searches the named mail alias files for each of the given -aliases. It creates a list of addresses for those aliases, and writes -that list on standard output. If I<targets> are omitted, all aliases -are displayed. +The I<imali> command searches the named alias files for each of +the given aliases. It creates a list of addresses for those +aliases, and writes that list on standard output. If I<targets> +are omitted, all aliases are displayed. + +This command is provided by IM (Internet Message). =head1 OPTIONS =over 5 -=item I<-f, --file = file> +=item I<-H, --host={on,off}> + +Lookup hosts alias file. + +=item I<-f, --file=FILE> + +Use I<FILE> as alias file. Default value is ~/.im/Aliases. -Use I<file> as a aliasfile. Default is ~/.im/Aliases. +=item I<-a, --addrbook=FILE> -=item I<-v, --verbose> +Use I<FILE> as addrbook file. Default value is ~/.im/Addrbook. + +=item I<-v, --verbose={on,off}> Print verbose messages when running. -=item I<-d, --debug> +=item I<--debug=DEBUG_OPTION> Print debug messages when running. =item I<-h, --help> -Print a usage message on standard output and exit successfully. +Display help message and exit. =back +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + =cut ### Copyright (C) 1997, 1998, 1999 IM developing team diff --git a/img/dist/IM/imcat.in b/img/dist/IM/imcat.in index e92f8221..0f67ffc9 100644 --- a/img/dist/IM/imcat.in +++ b/img/dist/IM/imcat.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: May 5, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imcat version 20000414(IM141)"; +my $VERSION = "imcat version 20021207(IM142)"; $Prog = 'imcat'; @@ -34,11 +34,10 @@ use vars qw($Prog $EXPLANATION @EnvConfig @OptConfig ## Environments ## -$EXPLANATION = " -imcat :: Display Messages -$VERSION +$EXPLANATION = "$VERSION +display mail/news message -Usage: imcat [options] msg +Usage: $Prog [OPTIONS] [FOLDER] MSG "; @EnvConfig = ( @@ -49,11 +48,11 @@ Usage: imcat [options] msg 'src;F;;' => "Folder.", 'join;b;;' => "join partial messages.", 'boundary;b;;' => "Print start boundary for Mew.", + 'SSHServer,S;s;localhost;SSH_server' + => 'SSH port relay server.', 'verbose;b;;' => 'With verbose messages.', 'debug;d;;' => "With debug message.", 'help;b;;' => "Show this message.", - 'SSHServer;s;localhost;SSH_server' - => 'SSH port relay server.', ); ## @@ -82,7 +81,7 @@ binmode(STDOUT); if ($msg =~ /^http:/i) { require IM::Http && import IM::Http qw(http_process); - my ($rc, $data) = http_process($msg, httpproxy(), noproxy()); + my($rc, $data) = http_process($msg, httpproxy(), noproxy()); if ($rc < 0) { im_die("can't access to message $msg.\n"); } @@ -139,7 +138,7 @@ if ($msg =~ /^http:/i) { } elsif ($opt_src =~ /^-/) { # News spool (-group[@server]) require IM::Nntp && import IM::Nntp qw(nntp_get_message); - my ($rc, $art) = nntp_get_message($opt_src, $msg); + my($rc, $art) = nntp_get_message($opt_src, $msg); im_die($art) if ($rc < 0); print $BOUNDARY if $opt_boundary; foreach (@$art) { @@ -149,7 +148,7 @@ if ($msg =~ /^http:/i) { # IMAP folder (%folder[:[user[/auth]]@server]) require IM::Imap && import IM::Imap; require IM::GetPass && import IM::GetPass; - my ($folder, $auth, $user, $host); + my($folder, $auth, $user, $host); $folder = $1; if ($folder !~ /[:\@]/) { @@ -160,10 +159,10 @@ if ($msg =~ /^http:/i) { ($folder, $auth, $user, $host) = imap_spec($folder); } - my ($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); + my($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); im_warn("accessing IMAP/$auth:$user\@$host\n") if (&verbose); - my ($rc, $HANDLE) = &imap_open($auth, $host, $user, $pass); + my($rc, $HANDLE) = &imap_open($auth, $host, $user, $pass); if ($rc < 0) { my $prompt = lc("imap/$auth:$user\@$host"); im_err("invalid password ($prompt).\n"); @@ -178,7 +177,7 @@ if ($msg =~ /^http:/i) { &imap_close($HANDLE); im_die("can't access to $folder\n"); } else { - my ($rc, $message) = &imap_get($HANDLE, $msg); + my($rc, $message) = &imap_get($HANDLE, $msg); &imap_close($HANDLE); if ($rc < 0) { im_die("can't access to message $msg in \%$folder.\n"); @@ -194,7 +193,7 @@ if ($msg =~ /^http:/i) { exit $EXIT_SUCCESS; -sub join_msg ($) { +sub join_msg($) { my $msg = shift; my $path; local $_; @@ -360,6 +359,66 @@ sub join_msg ($) { exit $EXIT_SUCCESS; } +__END__ + +=head1 NAME + +imcat - display mail/news message + +=head1 SYNOPSIS + +B<imcat> [OPTIONS] [FOLDER] MSG + +=head1 DESCRIPTION + +The I<imcat> command shows the contents of the mail/news message stored +in a folder. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER> + +Folder name. Default value is "+inbox". +"--src=+xxx" is equivalent to "+xxx". + +=item I<-j, --join={on,off}> + +Join partial messages. + +=item I<-b, --boundary={on,off}> + +Print start boundary for Mew version 1.x. + +=item I<-S, --sshserver=SERVER> + +SSH port relay server. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### @@ -391,4 +450,3 @@ sub join_msg ($) { ### Local Variables: ### mode: perl ### End: - diff --git a/img/dist/IM/imcd.in b/img/dist/IM/imcd.in index 22ba03df..4feadd76 100644 --- a/img/dist/IM/imcd.in +++ b/img/dist/IM/imcd.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imcd version 20000414(IM141)"; +my $VERSION = "imcd version 20021207(IM142)"; $Prog = 'imcd'; @@ -33,11 +33,10 @@ use vars qw($Prog $EXPLANATION @OptConfig ## Environments ## -$EXPLANATION = " -$Prog :: Internet Message Change Default Folder -$VERSION +$EXPLANATION = "$VERSION +change default folder of IM -Usage: $Prog [options] +Usage: $Prog [OPTIONS] [FOLDER] "; @OptConfig = ( @@ -76,6 +75,68 @@ print "$folder\n" unless $opt_quiet; exit $EXIT_SUCCESS; +__END__ + +=head1 NAME + +imcd - change default folder of IM + +=head1 SYNOPSIS + +B<imcd> [OPTIONS] [FOLDER] + +=head1 DESCRIPTION + +The I<imcd> command change the current folder of IM. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER> + +Set source folder. "--src=+xxx" is equivalent to "+xxx". + +=item I<-q, --quiet={on,off}> + +Do not show any messages. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 FILES + +=over 5 + +=item ~/.im/Context + +=back + +=head1 BUGS + +This feature is not well supported by the other im* commands. + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/imclean.in b/img/dist/IM/imclean.in index 611bdf4c..ae3eed3b 100644 --- a/img/dist/IM/imclean.in +++ b/img/dist/IM/imclean.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imclean version 20000414(IM141)"; +my $VERSION = "imclean version 20021207(IM142)"; $Prog = 'imclean'; @@ -34,22 +34,21 @@ use vars qw($Prog $EXPLANATION @OptConfig ## Environments ## -$EXPLANATION = " -$Prog :: Internet Message Garbage Cleanup -$VERSION +$EXPLANATION = "$VERSION +mail/news garbage cleanup -Usage: $Prog [options] [msgs...] +Usage: $Prog [OPTIONS] [FOLDER] [MSGS...] "; @OptConfig = ( 'src;F;;' => "Set a folder to be cleaned up.", + 'SSHServer,S;s;localhost;SSH_server' + => 'SSH port relay server.', 'noharm;b;;' => "Do not delete files, show what will be performed.", 'quiet;b;;' => "Do not show any messages.", 'verbose;b;;' => 'With verbose messages.', 'debug;d;;' => "With debug message.", 'help;b;;' => "Show this message.", - 'SSHServer,S;s;localhost;SSH_server' - => 'SSH port relay server.', ); ## @@ -76,9 +75,9 @@ exit $EXIT_SUCCESS; ## ## work horse -sub imclean ($@) { - my ($folder, @msgs) = @_; - my (@paths, $set, $HANDLE); +sub imclean($@) { + my($folder, @msgs) = @_; + my(@paths, $set, $HANDLE); if ($folder !~ /^%/) { @paths = get_message_paths($folder, @msgs); @@ -90,7 +89,7 @@ sub imclean ($@) { # IMAP folder (%folder[:[user[/auth]]@server]) require IM::Imap && import IM::Imap; require IM::GetPass && import IM::GetPass; - my ($ifld, $auth, $user, $host); + my($ifld, $auth, $user, $host); $ifld = $folder; if ($ifld !~ /[:\@]/) { @@ -101,7 +100,7 @@ sub imclean ($@) { ($ifld, $auth, $user, $host) = imap_spec($ifld); } - my ($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); + my($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); im_warn("accessing IMAP/$auth:$user\@$host\n") if (&verbose); (my $rc, $HANDLE) = imap_open($auth, $host, $user, $pass); @@ -133,8 +132,9 @@ sub imclean ($@) { if ($folder !~ /^%/) { my $i = 0; foreach (@paths) { - im_die("invalid message specification (unlinked $i message(s))\n") - if (!-f $_); + if (! -f $_) { + im_die("invalid message specification (unlinked $i message(s))\n"); + } im_unlink($_); $i++; } @@ -149,6 +149,67 @@ sub imclean ($@) { } } +__END__ + +=head1 NAME + +imclean - mail/news garbage cleanup + +=head1 SYNOPSIS + +B<imclean> [OPTIONS] [FOLDER] [MSGS...] + +=head1 DESCRIPTION + +The I<imclean> command delete all mail/news messages from +trash folder. + +If you do not want to delete all messages, specify message numbers. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER> + +Set a folder to be cleaned up. "--src=+xxx" is equivalent to "+xxx". +Default value is "+trash". + +=item I<-S, --sshserver=SERVER> + +SSH port relay server. + +=item I<-n, --noharm={on,off}> + +Do not delete files, show what will be performed. + +=item I<-q, --quiet={on,off}> + +Do not show any messages. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/imget.in b/img/dist/IM/imget.in index f7215cdf..6292ac46 100644 --- a/img/dist/IM/imget.in +++ b/img/dist/IM/imget.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Jan 14, 1996 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imget version 20000414(IM141)"; +my $VERSION = "imget version 20021207(IM142)"; $Prog = 'imget'; @@ -40,12 +40,10 @@ use vars qw($Prog $EXPLANATION @EnvConfig @OptConfig my $NNTP_processed; -$EXPLANATION = " -$Prog :: Internet Message Get -$VERSION - -Usage: $Prog [options] +$EXPLANATION = "$VERSION +get mail/news messages +Usage: $Prog [OPTIONS] "; @EnvConfig = ( @@ -79,18 +77,18 @@ Usage: $Prog [options] "\t\t(UIDL, LAST, STATUS, MSGID)\n" . "\t\tTimed out deletion is not supported with LAST.", 'usecl;b;;Obey_CL' => "Use value of Content-Length header for delimitation". - ".\n\t\t(effective only if source of messages is local).\n" , + ".\n\t\t(effective only if source of messages is local)." , 'count;i;;' => 'Number of messages to be gotten in a process (NNTP)', 'mode;s;get;' => 'Processing mode: "get", "from" or "check".', 'assoc;s;;' => "Association list: dst1=src1;dst2=src2;...\n" . "\t\tThis overrides --dst and --src options.", 'mimedecodequoted,x;b;;' => 'Decode broken mime-encoded strings', + 'SSHServer,S;s;localhost;SSH_server' + => 'SSH port relay server.', 'quiet;b;;' => 'Suppress informational messages.', 'verbose;b;;' => 'With verbose messages.', 'debug;d;;' => "With debug message.", 'help;b;;' => 'Display this help message.', - 'SSHServer,S;s;localhost;SSH_server' - => 'SSH port relay server.', ); ## @@ -155,11 +153,11 @@ read_petnames(); &set_scan_form($opt_form, $opt_width, $opt_jissafe); -my ($assoc, $msgs); +my($assoc, $msgs); if ($opt_assoc ne '') { foreach $assoc (split(';', $opt_assoc)) { if ($assoc =~ /(\S+)\s*=\s*(\S+)/) { - my ($dst, $src) = ($1, $2); + my($dst, $src) = ($1, $2); my $m = &get_sub($src, $dst, $opt_mode, $myinbox); $msgs = $m if ($m > $msgs); } else { @@ -183,8 +181,8 @@ if ($msgs > 0) { ## sub get_sub { - my ($src, $dst, $mode, $myinbox) = @_; - my ($msgs); + my($src, $dst, $mode, $myinbox) = @_; + my($msgs); if ($mode ne "get" && $mode ne "check" && $mode ne "from" && $mode ne "skip") { @@ -216,19 +214,19 @@ sub get_sub { return $msgs; } -sub process_stdin ($) { +sub process_stdin($) { my $noscan = shift; my @Message = (); while (<STDIN>) { - push (@Message, $_); + push(@Message, $_); } &store_message(\@Message, $opt_dst, $noscan); &exec_getsbrfile($opt_dst); } -sub alarm_func () { +sub alarm_func() { # no operation } @@ -237,6 +235,139 @@ sub alarm_func () { # auto refile # filter execution +__END__ + +=head1 NAME + +imget - get mail/news messages + +=head1 SYNOPSIS + +B<imget> [OPTIONS] + +=head1 DESCRIPTION + +The I<imget> command incorporates messages from mail/news servers. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=STRING> + +Message source: 'local[:path_of_mbox]', +'pop[/APOP|/RPOP|/POP][:user][@host]', +'imap[/AUTH|/LOGIN][:user][@host]', +'nntp:group[@host]', or +'stdin'. + +=item I<-d, --dst=STRING> + +Message destination: "+folder" or "=locally.saved.news". + +=item I<-n, --noscan={on,off}> + +No scan listings. + +=item I<-o, --scaninboxonly={on,off}> + +Do not show scanned-lines if InboxFolder != dst. + +=item I<-f, --form=STRING> + +Scan format. Default value is "%+5n %m%d %-14A %S || %b". + +=item I<-b, --buffer={on,off}> + +Make output data buffered. + +=item I<-j, --jissafe={on,off}> + +Safe manner for JIS. Default value is "on". + +=item I<-w, --width=NUM> + +Width of result for scan listings. Default value is 80. + +=item I<-l, --lock=STRING> + +Local mailbox locking style (none, flock, file). +Default value is "flock". + +=item I<-r, --rpath=STRING> + +conversion of UNIX From line into Return-Path: (append, ignore, replace). +Default value is "append". + +=item I<-k, --keep=NUM> + +Preserve messages. Default value is 0. + +(POP: in days; 0=delete immediately, -1=preserve forever) + +(otherwise: 0=delete immediately, non0=preserve forever) + +=item I<-p, --protokeep=STRING> + +Protocol type to use for keeping messages on POP (UIDL, LAST, STATUS, MSGID). +Timed out deletion is not supported with LAST. +Default value is "UIDL". + +=item I<-u, --usecl={on,off}> + +Use value of Content-Length header for delimitation. +(effective only if source of messages is local). + +=item I<-c, --count=NUM> + +Number of messages to be gotten in a process (NNTP). + +=item I<-m, --mode=STRING> + +Processing mode: "get", "from" or "check". +Default value is "get". + +=item I<-a, --assoc=STRING> + +Association list: dst1=src1;dst2=src2;... +This overrides --dst and --src options. + +=item I<-x, --mimedecodequoted={on,off}> + +Decode broken mime-encoded strings. + +=item I<-S, --sshserver=SERVER> + +SSH port relay server. + +=item I<-q, --quiet={on,off}> + +Do not show any messages. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/imgrep.in b/img/dist/IM/imgrep.in index 555db0ad..5fc160c4 100644 --- a/img/dist/IM/imgrep.in +++ b/img/dist/IM/imgrep.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imgrep version 20000414(IM141)"; +my $VERSION = "imgrep version 20021207(IM142)"; $Prog = 'imgrep'; @@ -49,12 +49,10 @@ my $range_element = '(\\d+|cur|first|last|next|prev|new)'; my $range_regexp = "($range_element(-$range_element|:[+-]?\\d+)?|all)"; my $ranges_regexp = "$range_regexp(,$range_regexp)?"; -$EXPLANATION = " -$Prog :: Internet Message GREP -$VERSION - -Usage :: $Prog [options] [+folder] [range] +$EXPLANATION = "$VERSION +search for mail/news messages +Usage: $Prog [OPTIONS] [FOLDER] [RANGE] "; @OptConfig = ( @@ -106,10 +104,10 @@ my $default_folder = cur_folder(); # must set here @opt_src = sortuniq(@opt_src); -@opt_src or @opt_src = ( $default_folder ); -@default_ranges = ( @ARGV ? @ARGV : 'all' ); +@opt_src or @opt_src = ($default_folder); +@default_ranges = (@ARGV ? @ARGV : 'all'); -if ( $opt_format eq 'number' and @opt_src > 1 ) { +if ($opt_format eq 'number' and @opt_src > 1) { $opt_format = 'path'; } @@ -126,26 +124,26 @@ my $matched = 0; FOLDER: foreach (@opt_src) { - my ($folder, $ranges) = (/^(.*?)(:$ranges_regexp)?$/); + my($folder, $ranges) = (/^(.*?)(:$ranges_regexp)?$/); $ranges =~ s/^:(.*)$/$1/; my $folder_dir; my @ranges = split(',', $ranges); my @messages = (); - if ( $folder =~ /^\-/ ) { + if ($folder =~ /^\-/) { im_warn("Newsspool $folder search not supported (ignored)\n"); next FOLDER; } - @ranges = ( $ranges ? @ranges : @default_ranges ); + @ranges = ($ranges ? @ranges : @default_ranges); $folder_dir = expand_path($folder); @messages = grep_folder($folder_dir, $eval_string, $opt_dupchecktarget, @ranges); - if ( @messages ) { + if (@messages) { $matched += @messages; - foreach ( @messages ) { + foreach (@messages) { print "$folder:" if ($opt_format eq 'folder'); print "$folder_dir/" if ($opt_format eq 'path'); print "$_\n"; @@ -169,6 +167,106 @@ exit $EXIT_SUCCESS; ## ################################################## +__END__ + +=head1 NAME + +imgrep - search for mail/news messages + +=head1 SYNOPSIS + +B<imgrep> [OPTIONS] [FOLDER] [RANGE] + +=head1 DESCRIPTION + +The I<imgrep> command enumerates mail/news messages matched given patterns. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER,FOLDER...> + +message source: "+folder:[range[,range..]]". + +"--src=+xxx" is equivalent to "+xxx". + +=item I<-f, --format=STRING> + +Output format: "number", "folder", or "path". + +(default: "number" for single target folder, "path" for multiple target folders) + +=item I<-c, --casefold={on,off}> + +Case sensitivity. +(This option affects both fieldname and pattern.) + +Default value is "on". + +=item I<-e, --expression=STRING> + +Search expression: + +Usable keyword + + & && logical AND + + | || logical OR + + ! logical NOT + + ( ) parens + + fieldname=pattern search pattern for the field + +Special fieldname: + + head Entire header + + body Entire body + + all Entire message + +=item I<-d, --delimiter=STRING> + +Mail header delimiter. + +Default value is "\n\n|\n----\n". + +=item I<-D, --dupchecktarget=STRING> + +Duplicate check target ('none', 'message-id', or 'message-id+subject'). +Default value is 'none'. + +=item I<-q, --quiet={on,off}> + +Do not show any messages. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/imhist.in b/img/dist/IM/imhist.in index d65af634..a2776578 100644 --- a/img/dist/IM/imhist.in +++ b/img/dist/IM/imhist.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Jul 6, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imhist version 20000414(IM141)"; +my $VERSION = "imhist version 20021207(IM142)"; $Prog = 'imhist'; @@ -37,11 +37,10 @@ use vars qw($Prog $EXPLANATION @OptConfig ## Environments ## -$EXPLANATION = " -imhist :: Manage History Database -$VERSION +$EXPLANATION = "$VERSION +treat mail/news history database -Usage: imhist [options] +Usage: imhist [OPTIONS] "; @OptConfig = ( @@ -136,9 +135,9 @@ if ($opt_lookup ne '') { exit $EXIT_SUCCESS; -sub add_msg_info ($$) { - my ($path, $msg) = @_; - local (@Hdr) = (); +sub add_msg_info($$) { + my($path, $msg) = @_; + local(@Hdr) = (); if (im_open(\*MSG, "<$path")) { &read_header(\*MSG, \@Hdr, 0); my $mid = &header_value(\@Hdr, 'Message-ID'); @@ -164,8 +163,8 @@ sub add_msg_info ($$) { return -1; } -sub add_folder_info ($$) { - my ($dir, $folder) = @_; +sub add_folder_info($$) { + my($dir, $folder) = @_; $dir =~ s|/$||; im_info("Entering folder $dir\n"); chdir ($dir); @@ -185,7 +184,7 @@ sub add_folder_info ($$) { } } closedir(FOLDER); - if($opt_subfolders eq '1'){ + if ($opt_subfolders eq '1') { my $l; foreach $l (@lower) { if ($folder eq '+') { @@ -197,6 +196,72 @@ sub add_folder_info ($$) { } } +__END__ + +=head1 NAME + +imhist - treat mail/news history database + +=head1 SYNOPSIS + +B<imhist> [OPTIONS] + +=head1 DESCRIPTION + +The I<imhist> command handles mail/news history database. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-l, --lookup=STRING> + +Look up an entry for specified message-id. + +=item I<-r, --remove=STRING> + +Remove whole information on specified message-id. + +=item I<-m, --msg=STRING> + +Message to be deleted if multiple in database. + +=item I<-d, --dump={on,off}> + +Dump database just for debugging. + +=item I<-a, --add=FOLDER> + +Add information of messages in a specified folder. + +=item I<-s, --subfolders={on,off}> + +Descend sub folders recursively (option for --add). + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/imhsync.in b/img/dist/IM/imhsync.in index 46351d4d..756d6e25 100644 --- a/img/dist/IM/imhsync.in +++ b/img/dist/IM/imhsync.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Jul 02, 1998 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imhsync version 20000414(IM141)"; +my $VERSION = "imhsync version 20021207(IM142)"; $Prog = 'imhsync'; @@ -35,11 +35,10 @@ use vars qw($Prog $EXPLANATION @OptConfig @Hdr %Folder ## Environments ## -$EXPLANATION = " -imhsync :: Refile by another DB -$VERSION +$EXPLANATION = "$VERSION +refile mail/news messages by another DB -Usage: imhsync [options] +Usage: imhsync [OPTIONS] "; @OptConfig = ( @@ -95,16 +94,16 @@ if ($opt_folder eq '') { exit $EXIT_SUCCESS; -sub db_refile ($$) { - my ($msg, $folder) = @_; - my ($multi_folder); - local (@Hdr) = (); +sub db_refile($$) { + my($msg, $folder) = @_; + my($multi_folder); + local(@Hdr) = (); if (im_open(\*MSG, "<$msg")) { &read_header(\*MSG, \@Hdr, 0); - close (MSG); + close(MSG); my $mid = &header_value(\@Hdr, 'Message-ID'); my $dest = my_history_lookup($mid, 0); - my ($f, $df); + my($f, $df); $multi_folder = 0; $df = ''; foreach $f (split(',', $dest)) { @@ -128,11 +127,11 @@ sub db_refile ($$) { return -1; } -sub folder_db_refile ($$) { - my ($dir, $folder) = @_; +sub folder_db_refile($$) { + my($dir, $folder) = @_; $dir =~ s|/$||; im_info("Refiling folder $dir\n"); - chdir ($dir); + chdir($dir); unless (opendir(FOLDER, $dir)) { im_warn("can't read $dir\n"); return -1; @@ -156,8 +155,8 @@ sub folder_db_refile ($$) { use vars qw($DBtype $nodbfile $DB_HASH %History); -sub my_history_open ($$) { - my ($dbfile) = @_; +sub my_history_open($$) { + my($dbfile) = @_; $DBtype = msgdbtype(); # package global unless ($DBtype) { $DBtype = 'DB'; @@ -185,13 +184,13 @@ sub my_history_open ($$) { im_debug("history database: $dbfile\n") if (&debug('history')); - my ($db, $fd); + my($db, $fd); if ($DBtype eq 'DB') { $db = tie %History, 'DB_File', $dbfile, O_RDONLY(), 0444; } elsif ($DBtype eq 'NDBM') { $db = tie %History, 'NDBM_File', $dbfile, O_RDONLY(), 0444; } elsif ($DBtype eq 'SDBM') { - if (&win95p || &os2p){ + if (&win95p || &os2p) { $db = tie %History, 'SDBM_File', $dbfile, O_RDONLY(), 0444; } else { $db = tie %History, 'SDBM_File', $dbfile, O_RDONLY(), 0444; @@ -213,7 +212,7 @@ sub my_history_open ($$) { } -sub my_history_close () { +sub my_history_close() { if ($nodbfile) { im_err("no database specified.\n"); return; @@ -222,12 +221,12 @@ sub my_history_close () { } -sub my_history_lookup ($$) { +sub my_history_lookup($$) { if ($nodbfile) { im_err("no database specified.\n"); return (); } - my ($msgid, $field) = @_; + my($msgid, $field) = @_; $msgid =~ s/^<(.*)>$/$1/; if (defined($History{$msgid})) { if ($field == LookUpAll) { @@ -244,3 +243,85 @@ sub my_history_lookup ($$) { } } } + +__END__ + +=head1 NAME + +imhsync - refile mail/news messages by another DB + +=head1 SYNOPSIS + +B<imhsync> [OPTIONS] + +=head1 DESCRIPTION + +The I<imhsync> command handles mail/news messages by another DB. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-d, --db=STRING> + +reference DB. + +=item I<-f, --folder=STRING> + +folder to be refiled. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + +### Copyright (C) 1997, 1998, 1999 IM developing team +### 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 team 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 TEAM 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 TEAM 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. + +### Local Variables: +### mode: perl +### End: diff --git a/img/dist/IM/imjoin.in b/img/dist/IM/imjoin.in index d005dcde..1ef03e93 100644 --- a/img/dist/IM/imjoin.in +++ b/img/dist/IM/imjoin.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: May 5, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imjoin version 20000414(IM141)"; +my $VERSION = "imjoin version 20021207(IM142)"; $Prog = 'imjoin'; @@ -33,16 +33,15 @@ use vars qw($Prog $EXPLANATION @EnvConfig @OptConfig $opt_noscan ## Environments ## -$EXPLANATION = " -imjoin :: Join Message/partial Messages -$VERSION +$EXPLANATION = "$VERSION +join Message/partial messages -Usage: imjoin [options] msg +Usage: imjoin [OPTIONS] MSGS "; @OptConfig = ( - 'src;f;;' => "Folder.", - 'dst;s;+inbox;' => "Folder.", + 'src;f;;' => "Source folder.", + 'dst;s;+inbox;' => "Destination folder.", 'verbose;b;;' => 'With verbose messages.', 'debug;d;;' => "With debug message.", 'help;b;;' => "Show this message.", @@ -77,7 +76,7 @@ if ($opt_dst eq "stdout") { exit $EXIT_SUCCESS; -sub join_msg ($) { +sub join_msg($) { my @msgs = @_; my @paths; my @index; @@ -104,7 +103,7 @@ sub join_msg ($) { # sort each part number on each part my $total = 0; - my ($path, $header); + my($path, $header); foreach $path (@paths) { if (im_open(\*MSG, "<$path")) { $/ = "\n\n"; @@ -170,7 +169,7 @@ sub join_msg ($) { next; } last if (/^$/); - push (@Message, "$_\n"); + push(@Message, "$_\n"); } $header = <MSG>; $skip = 0; @@ -182,9 +181,9 @@ sub join_msg ($) { next; } last if (/^$/); - push (@Message, "$_\n"); + push(@Message, "$_\n"); } - push (@Message, "\n"); + push(@Message, "\n"); } else { # skip header part <MSG>; @@ -200,7 +199,7 @@ sub join_msg ($) { return @Message; } -sub get_paths ($) { +sub get_paths($) { my $msg = shift; my $path; local $_; @@ -282,6 +281,56 @@ sub get_paths ($) { return @paths; } +__END__ + +=head1 NAME + +imjoin - join Message/partial messages + +=head1 SYNOPSIS + +B<imjoin> [OPTIONS] MSGS + +=head1 DESCRIPTION + +The I<imjoin> command joins Message/partial messages. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER> + +Source folder. + +=item I<-d, --dst=FOLDER> + +Destination folder. Default value is "+inbox". + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/imls.in b/img/dist/IM/imls.in index 532ba9ae..5a2faedf 100644 --- a/img/dist/IM/imls.in +++ b/img/dist/IM/imls.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Dec 31, 1995 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imls version 20000414(IM141)"; +my $VERSION = "imls version 20021207(IM142)"; $Prog = 'imls'; @@ -48,11 +48,10 @@ my $START = 0; my $THREAD_INDENT; -$EXPLANATION = " -$Prog :: Internet Message List -$VERSION +$EXPLANATION = "$VERSION +list up the contents of mail/news folder -Usage :: $Prog [options] [+folder] [range] +Usage: $Prog [OPTIONS] [FOLDER] [RANGE] "; @OptConfig = ( @@ -70,12 +69,12 @@ Usage :: $Prog [options] [+folder] [range] 'delimiter;s;\n\n|\n----\n;' => 'Mail header delimiter', 'dupchecktarget,D;s;;' => 'Duplicate Check Target', 'mimedecodequoted,x;b;;' => 'Decode broken mime-encoded strings', + 'SSHServer,S;s;localhost;SSH_server' + => 'SSH port relay server.', 'quiet;b;;' => 'Suppress informational messages.', 'verbose;b;;' => 'With verbose messages.', 'debug;d;;' => "With debug message.", 'help;b;;' => 'Show this message', - 'SSHServer,S;s;localhost;SSH_server' - => 'SSH port relay server.', ); ## @@ -105,7 +104,7 @@ if (scalar(@opt_src) < 1) { } elsif ($opt_grep) { require IM::Folder && import IM::Folder; require IM::Grep && import IM::Grep; - if ($opt_namazu){ + if ($opt_namazu) { &vscan_namazu(@ARGV); } else { &vscan(); @@ -153,14 +152,14 @@ if (scalar(@opt_src) < 1) { ## Local Mail and News ## -sub local_files ($@) { +sub local_files($@) { my $folder = shift; my @arg = @_; my %Head = (); my $num; foreach $num (get_message_paths($folder, @arg)) { - if ( -f $num ) { + if (-f $num) { %Head = &get_header($num); $FIRST = $Head{'number:'} if $FIRST == 0; if ($opt_thread) { @@ -179,10 +178,10 @@ sub local_files ($@) { ## News by NNTP ## -sub nntp_messages ($@) { - my ($newsgroup, @ranges) = @_; - my ($resp, $start, $end, $rc); -# my ($num, $subj, $from, $date, $id, $ref, $num1, $num2); +sub nntp_messages($@) { + my($newsgroup, @ranges) = @_; + my($resp, $start, $end, $rc); +# my($num, $subj, $from, $date, $id, $ref, $num1, $num2); ($newsgroup, my $srvs) = nntp_spec($newsgroup, nntpservers()); local(@servers) = split(',', $srvs); @@ -195,7 +194,7 @@ sub nntp_messages ($@) { } } while (@servers > 0 && $rc > 0); im_die("can not access $newsgroup on $srvs.\n") if ($rc); - my (@resp) = &nntp_command_response; + my(@resp) = &nntp_command_response; my $error = 0; my $i; for ($i = 0; $i <= $#resp; $i++) { @@ -335,8 +334,8 @@ sub make_thread { ## Display subroutines ## -sub disp_thread ($$) { - my ($point, $indent) = @_; +sub disp_thread($$) { + my($point, $indent) = @_; if ($point != $START) { my $c = $point->{'head'}; @@ -359,7 +358,7 @@ sub disp_thread ($$) { ### vscan ### -sub vscan () { +sub vscan() { my $num = 1; my $folder; my $eval_string; @@ -367,23 +366,23 @@ sub vscan () { $eval_string = parse_expression($opt_grep, $opt_casefold); foreach (@opt_src) { - my ($folder, $ranges) = (/([^:]+)(?::)?(.*)?/); + my($folder, $ranges) = (/([^:]+)(?::)?(.*)?/); my $folder_dir; my @ranges = split(',', $ranges); my @messages = (); - if ( $folder =~ /^\-/ ) { + if ($folder =~ /^\-/) { im_warn("Newsspool $folder search not supported (ignored)\n"); next FOLDER; } - @ranges = ( $ranges ? @ranges : 'all' ); + @ranges = ($ranges ? @ranges : 'all'); $folder_dir = expand_path($folder); @messages = grep_folder($folder_dir, $eval_string, 'none', @ranges); - foreach ( @messages ) { - if ( -f "$folder_dir/$_" ) { + foreach (@messages) { + if (-f "$folder_dir/$_") { my %Head = &get_header("$folder_dir/$_"); $Head{'pnum'} = $Head{'number:'}; $Head{'number:'} = $num; @@ -399,12 +398,12 @@ sub vscan () { ### ### vscan_namazu ### -sub vscan_namazu (@) { +sub vscan_namazu(@) { my $num = shift; my $nmzidx; my $nmzargs; - $num = 1 if($num eq 'all'); + $num = 1 if ($num eq 'all'); if (&namazuv2()) { $nmzargs = "--all --list --early"; } else { @@ -417,15 +416,15 @@ sub vscan_namazu (@) { my @messages = (); im_open(\*NMZ, "namazu $nmzargs \"$opt_grep\" $nmzidx|") - || im_err( "namazu error\n"); + || im_err("namazu error\n"); @messages = sort {$a <=> $b} <NMZ>; - close( NMZ ); + close(NMZ); - foreach ( @messages ) { + foreach (@messages) { chop; s/^\/([a-zA-Z])\|/\1:/; $_ = expand_path($_); - if ( -f $_ ) { + if (-f $_) { my %Head = &get_header($_); $Head{'pnum'} = $Head{'number:'}; $Head{'number:'} = $num; @@ -442,8 +441,8 @@ sub vscan_namazu (@) { ### nntp_message_number ### -sub nntp_message_number ($$$) { - my ($min, $max, $num) = @_; +sub nntp_message_number($$$) { + my($min, $max, $num) = @_; $num =~ /^\d+$/ && return $num; $num =~ /^first$/ && return $min; $num =~ /^last$/ && return $max; @@ -454,10 +453,10 @@ sub nntp_message_number ($$$) { ### nntp_message_range ### -sub nntp_message_range ($$$) { - my ($range, $min, $max) = @_; - my ($start, $end, $n) = ('', '', ''); - my (@filesinfolder) = ($min..$max); +sub nntp_message_range($$$) { + my($range, $min, $max) = @_; + my($start, $end, $n) = ('', '', ''); + my(@filesinfolder) = ($min..$max); my $dir; if ($range eq 'all') { @@ -499,18 +498,18 @@ sub nntp_message_range ($$$) { return @filesinfolder; } - return (&nntp_message_number($min, $max, $range)); + return(&nntp_message_number($min, $max, $range)); } -sub get_nntp_message_range ($$@) { - my ($min, $max, @ranges) = (shift, shift, @_); - my (@filesinfolder) = (); +sub get_nntp_message_range($$@) { + my($min, $max, @ranges) = (shift, shift, @_); + my(@filesinfolder) = (); my $range; foreach $range (@ranges) { push(@filesinfolder, nntp_message_range($range, $min, $max)); } - return (&sort_uniq(@filesinfolder)); + return(&sort_uniq(@filesinfolder)); } ############################################ @@ -518,9 +517,9 @@ sub get_nntp_message_range ($$@) { ## IMAP ## -sub imap_messages ($@) { - my ($folder, @ranges) = @_; - my ($auth, $user, $host); +sub imap_messages($@) { + my($folder, @ranges) = @_; + my($auth, $user, $host); if ($folder !~ /[:\@]/) { # Use ImapAccount spec, unless user or host is specified. @@ -530,10 +529,10 @@ sub imap_messages ($@) { ($folder, $auth, $user, $host) = imap_spec($folder); } - my ($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); + my($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); im_warn("accessing IMAP/$auth:$user\@$host\n") if (&verbose); - my ($rc, $HANDLE) = &imap_open($auth, $host, $user, $pass); + my($rc, $HANDLE) = &imap_open($auth, $host, $user, $pass); if ($rc < 0) { my $prompt = lc("imap/$auth:$user\@$host"); im_err("invalid password ($prompt).\n"); @@ -562,7 +561,7 @@ sub imap_messages ($@) { return 0; } -sub sort_uniq (@) { +sub sort_uniq(@) { my(@target) = @_; my(%tmp); my($i); @@ -574,19 +573,121 @@ sub sort_uniq (@) { return sort {$a <=> $b} keys %tmp; } -sub uniq (@) { +sub uniq(@) { my @array = @_; my %hash; - foreach (@array){ + foreach (@array) { $hash{$_} = $_; } return keys(%hash); } -## -## End of imls -## +__END__ + +=head1 NAME + +imls - list up the contents of the folder + +=head1 SYNOPSIS + +B<imls> [OPTIONS] [FOLDER] [RANGE] + +=head1 DESCRIPTION + +The I<imls> command produces a one line per message listing of the +specified folder or mail/news messages. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER,FOLDER...> + +Folder name. Default value is "+inbox". +"--src=+xxx" is equivalent to "+xxx". + +=item I<-f, --form=STRING> + +Scan format. Default value is "%+5n %m%d %-14A %S || %b". + +=item I<-b, --buffer={on,off}> + +Make output data buffered. + +=item I<-j, --jissafe={on,off}> + +Safe manner for JIS. Default value is "on". + +=item I<-w, --width=NUM> + +Width of result for scan listings. Default value is 80. + +=item I<-t, --thread={on,off}> + +Make threads. + +=item I<-i, --indent=NUM> + +Width of thread indent. Default value is 2. + +=item I<-g, --grep=STRING> + +Grep pattern for vscan. + +=item I<-n, --namazu={on,off}> + +Use namazu for vscan. + +=item I<-c, --casefold={on,off}> + +Case sensitivity. Default value is "on". +(This option affects both fieldname and pattern.) + +=item I<-d, --delimiter=STRING> + +Mail header delimiter. Default value is "\n\n|\n----\n". + +=item I<-D, --dupchecktarget=STRING> + +Duplicate check target ('none', 'message-id', or 'message-id+subject'). +Default value is "message-id". + +=item I<-x, --mimedecodequoted={on,off}> + +Decode broken mime-encoded strings. + +=item I<-S, --sshserver=SERVER> + +SSH port relay server. + +=item I<-q, --quiet={on,off}> + +Do not show any messages. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. diff --git a/img/dist/IM/immknmz.in b/img/dist/IM/immknmz.in index fe6f1a50..fc42e3e6 100644 --- a/img/dist/IM/immknmz.in +++ b/img/dist/IM/immknmz.in @@ -5,8 +5,9 @@ ### "mew-nmz-mknmz-all-folders" (in mew-nmz.el) ### ### Author: Shuichi Kitaguchi <kit@Mew.org> +### Internet Message Group <img@mew.org> ### Created: Sep 23, 1999 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -14,7 +15,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "immknmz version 20000414(IM141)"; +my $VERSION = "immknmz version 20021207(IM142)"; $Prog = 'immknmz'; @@ -23,7 +24,7 @@ $Prog = 'immknmz'; ### my $nmzdir = "Namazu"; # "~/$nmzdir" my $mknmz_include = "mknmz-inc.pl"; # mknmz -I <file> -my @ignorefolders = ( "draft", "trash", "schedule", "queue", ); +my @ignorefolders = ("draft", "trash", "schedule", "queue",); # Code: @@ -35,11 +36,10 @@ use IO::File; use strict; use vars qw($Prog $EXPLANATION @OptConfig $opt_help $opt_gcnmz $opt_verbose $opt_timestamp); -$EXPLANATION = " -$Prog :: mew-nmz-mknmz-all-folders -$VERSION +$EXPLANATION = "$VERSION +make namazu index for mail/news folders -Usage: $Prog [options] +Usage: $Prog [OPTIONS] "; @OptConfig = ( @@ -55,19 +55,32 @@ read_opt(\@ARGV); help($EXPLANATION) && exit $EXIT_SUCCESS if $opt_help; sub get_mtime { - my ($path) = @_; - my ($dev,$ino,$mode,$nlink,$uid,$gid, - $rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat($path) or return -1; + my($path) = @_; + my($dev,$ino,$mode,$nlink,$uid,$gid, + $rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($path) or return -1; return $mtime; } +my $lockdir = namazu_lock_path(); +if ($lockdir) { + unless (mkdir($lockdir, 0700)) { + print STDERR "$Prog: can not create lock directory: $lockdir.\n"; + exit $EXIT_ERROR; + } +} +sub unlock_exit($) { + my($status) = @_; + rmdir $lockdir if $lockdir; + exit $status; +} + my $mailpath = mail_path()."/"; my $namazupath = home_dir()."/$nmzdir/".mail_dir()."/"; my $mknmz_args = "-q"; my $incfile = home_dir()."/$nmzdir/$mknmz_include"; -if ( ! -f $incfile ){ +if (! -f $incfile) { $incfile = ""; } my $folderspath = $mailpath."/.folders"; @@ -78,38 +91,39 @@ my $nmzfolder; my $gcnmztgt; my $ret; my @filelist; +my $tempdir; my $tempfile; my $timestamp; -if ( $ENV{'TEMP'} eq "" ){ - if ( $ENV{'TMP'} eq "" ){ - $tempfile = "/tmp"; # UNIX system, may be. - } else { - $tempfile = $ENV{'TMP'}; - } -} else { - $tempfile = $ENV{'TEMP'}; + +$tempdir = $ENV{TMPDIR} || $ENV{TMP} || $ENV{TEMP} || '/tmp'; +$tempdir =~ s:\\:/:g; +$tempdir =~ s/\/+$//; +$tempdir = sprintf("%s/immknmz-%d-%d", $tempdir, $$, time()); +rmdir $tempdir; +unless (mkdir($tempdir, 0700)) { + print STDERR "$Prog: can not create directory: $tempdir.\n"; + unlock_exit($EXIT_ERROR); } -$tempfile =~ s:\\:/:g; -$tempfile =~ s/\/$//; -$tempfile = "$tempfile/immknmz_temporary_file"; +$tempfile = "$tempdir/tempfile"; + $mknmz_args = "" if $opt_verbose; -im_open(\*FILE, "<$folderspath" ); -while ( <FILE> ){ +im_open(\*FILE, "<$folderspath"); +while (<FILE>) { s/\r$// if &win95p() || &os2p(); chomp; $msgfolder = $_; $flag = 0; - foreach ( @ignorefolders ){ - if ( $msgfolder !~ /^\+/ ){ # ! local folder + foreach (@ignorefolders) { + if ($msgfolder !~ /^\+/) { # ! local folder $flag=1; last; - } elsif ( $msgfolder =~ /^\+$_/ ){ # == @ignorefolders + } elsif ($msgfolder =~ /^\+$_/) { # == @ignorefolders $flag=1; last; } } - if ( $flag != 0 ){ + if ($flag != 0) { print "skipping $msgfolder...\n"; flush('STDOUT'); } else { @@ -140,16 +154,20 @@ while ( <FILE> ){ @filelist = grep(/^[0-9]*$/ && -f "$msgfolder/$_",readdir(DIR)); closedir(DIR); - if ((&win95p() || &os2p()) && !&namazuv2()){ + if ((&win95p() || &os2p()) && !&namazuv2()) { $msgfolder =~ s:/:\\:g; } - if ( scalar(@filelist) > 0 ){ - sysopen(\*TEMPFILE, "$tempfile", O_RDWR | O_EXCL | O_CREAT, 0600) || die; + if (scalar(@filelist) > 0) { + unless (sysopen(\*TEMPFILE, "$tempfile", + O_RDWR()|O_CREAT()|O_EXCL(), 0600)) { + print STDERR "$Prog: can not create file: $tempfile.\n"; + unlock_exit($EXIT_ERROR); + } binmode(\*TEMPFILE); - foreach ( @filelist ){ - if (!-d "$msgdir/$_"){ - if ((&win95p() || &os2p()) && !&namazuv2()){ + foreach (@filelist) { + if (! -d "$msgdir/$_") { + if ((&win95p() || &os2p()) && !&namazuv2()) { print TEMPFILE "$msgfolder\\$_\n"; } else { print TEMPFILE "$msgfolder/$_\n"; @@ -163,13 +181,13 @@ while ( <FILE> ){ print "$Prog: processing $msgfolder ...\n"; flush('STDOUT'); - if ( $incfile eq "" ){ + if ($incfile eq "") { $ret = system "mknmz -Uh $mknmz_args -O $nmzfolder -F $tempfile"; } else { $ret = system "mknmz -Uh $mknmz_args -O $nmzfolder -F $tempfile -I $incfile"; } unlink $tempfile; - if ( $ret == 2 ){ + if ($ret == 2) { print "$Prog: abort.\n"; flush('STDOUT'); last; @@ -183,8 +201,8 @@ while ( <FILE> ){ opendir(DIR,$nmzfolder); @filelist = grep(/^.*.BAK$/ && -f "$nmzfolder/$_",readdir(DIR)); closedir(DIR); - if ( scalar(@filelist) > 0 ){ - foreach ( @filelist ){ + if (scalar(@filelist) > 0) { + foreach (@filelist) { unlink "$nmzfolder" . "/$_"; } } @@ -195,8 +213,83 @@ while ( <FILE> ){ } } close(FILE); +rmdir $tempdir; +unlock_exit($EXIT_SUCCESS); + +__END__ + +=head1 NAME + +immknmz - make namazu index for mail/news folders + +=head1 SYNOPSIS + +B<immknmz> [OPTIONS] + +=head1 DESCRIPTION + +The I<immknmz> command makes namazu index for mail/news folders. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-g, --gcnmz={on,off}> + +Use gcnmz after mknmz (Garbage Collection for Namazu index). + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<-t, --timestamp={on,off}> + +Use checking time stamp. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + +### Copyright (C) 1997, 1998, 1999 IM developing team +### 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 team 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 TEAM 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 TEAM 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. -# immknmz ends here. ### Local Variables: ### mode: perl ### End: diff --git a/img/dist/IM/immv.in b/img/dist/IM/immv.in index 88e3232e..9a466110 100644 --- a/img/dist/IM/immv.in +++ b/img/dist/IM/immv.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "immv version 20000414(IM141)"; +my $VERSION = "immv version 20021207(IM142)"; $Prog = 'immv'; @@ -39,23 +39,22 @@ use vars qw($Prog $EXPLANATION @OptConfig my %NewMsgCache = (); -$EXPLANATION = " -$Prog :: Internet Message Move -$VERSION +$EXPLANATION = "$VERSION +file mail/news message in other folders -Usage: $Prog [options] +folder... msgs... +Usage: $Prog [OPTIONS] FOLDER... MSGS... "; @OptConfig = ( 'src;f;;' => "Set source folder.", 'dst;F@;;' => "Set destination folders.", 'link;b;;' => "Remain original msg in src folder.", + 'SSHServer,S;s;localhost;SSH_server' + => 'SSH port relay server.', 'noharm;b;;' => "Display the commands but do not actually execute them.", 'verbose;b;;' => 'With verbose messages.', 'debug;d;;' => "With debug message.", 'help;b;;' => "Show this message.", - 'SSHServer,S;s;localhost;SSH_server' - => 'SSH port relay server.', ); ## @@ -87,10 +86,10 @@ exit $EXIT_SUCCESS; ## ## Work horse ## -sub immv ($$$) { - my ($src, $dsts, $msgs) = @_; - my (@imap_dsts, @local_dsts); - my ($imap_src, $imap_dst, $news_src, $news_dst) = (0, 0, 0, 0); +sub immv($$$) { + my($src, $dsts, $msgs) = @_; + my(@imap_dsts, @local_dsts); + my($imap_src, $imap_dst, $news_src, $news_dst) = (0, 0, 0, 0); if ($src =~ /^-/) { $news_src = 1; @@ -150,7 +149,7 @@ sub immv ($$$) { } sub local2local($$$) { - my ($src, $dsts, $msgs) = @_; + my($src, $dsts, $msgs) = @_; my @msg_paths = get_impath($src, @$msgs); foreach (@msg_paths) { @@ -159,8 +158,8 @@ sub local2local($$$) { } sub imap2local($$$) { - my ($src, $dsts, $msgs) = @_; - my ($msg, $Message); + my($src, $dsts, $msgs) = @_; + my($msg, $Message); foreach $msg (@$msgs) { $Message = imap_get_message($src, $msg); @@ -170,8 +169,8 @@ sub imap2local($$$) { } sub news2local($$$) { - my ($src, $dsts, $msgs) = @_; - my ($msg, $rc, $Message); + my($src, $dsts, $msgs) = @_; + my($msg, $rc, $Message); foreach $msg (@$msgs) { ($rc, $Message) = nntp_get_message($src, $msg); @@ -180,12 +179,12 @@ sub news2local($$$) { } } -sub refile_one ($$$) { - my ($src, $dsts, $msg) = @_; - my ($dst, $dst_path, $link_it); +sub refile_one($$$) { + my($src, $dsts, $msg) = @_; + my($dst, $dst_path, $link_it); foreach $dst (@{$dsts}) { - if ($NewMsgCache{$dst}){ + if ($NewMsgCache{$dst}) { $NewMsgCache{$dst} =~ s|([^/]+)$|$1+1|e; # increment cache $dst_path = $NewMsgCache{$dst}; } else { @@ -209,8 +208,8 @@ sub refile_one ($$$) { } } -sub local2imap ($$$) { - my ($src, $dsts, $msgs) = @_; +sub local2imap($$$) { + my($src, $dsts, $msgs) = @_; my $msg; foreach $msg (@$msgs) { @@ -222,9 +221,9 @@ sub local2imap ($$$) { } } -sub news2imap ($$$) { - my ($src, $dsts, $msgs) = @_; - my ($msg, $rc, $Message); +sub news2imap($$$) { + my($src, $dsts, $msgs) = @_; + my($msg, $rc, $Message); foreach $msg (@$msgs) { ($rc, $Message) = nntp_get_message($src, $msg); @@ -233,20 +232,83 @@ sub news2imap ($$$) { } } -sub imap2imap ($$$) { +sub imap2imap($$$) { imap_refile(@_); } -sub uniq (@) { +sub uniq(@) { my @array = @_; my %hash; - foreach (@array){ + foreach (@array) { $hash{$_} = $_; } return keys(%hash); } +__END__ + +=head1 NAME + +immv - file mail/news message in other folders + +=head1 SYNOPSIS + +B<immv> [OPTIONS] FOLDER... MSGS... + +=head1 DESCRIPTION + +The I<immv> command moves messages from the source folder to the +destination folders. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER> + +Set source folder. Default value is "+inbox". + +=item I<-d, --dst=FOLDER,FOLDER...> + +Set destination folders. "--dst=+xxx" is equivalent to "+xxx". + +=item I<-l, --link={on,off}> + +Remain original msg in src folder. + +=item I<-S, --sshserver=SERVER> + +SSH port relay server. + +=item I<-n, --noharm={on,off}> + +Display the commands but do not actually execute them. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/impack.in b/img/dist/IM/impack.in index 15cb7f98..ad996271 100644 --- a/img/dist/IM/impack.in +++ b/img/dist/IM/impack.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "impack version 20000414(IM141)"; +my $VERSION = "impack version 20021207(IM142)"; $Prog = 'impack'; @@ -34,11 +34,10 @@ use vars qw($Prog $EXPLANATION @OptConfig ## Environments ## -$EXPLANATION = " -$Prog :: Internet Message Pack -$VERSION +$EXPLANATION = "$VERSION +pack mail/news messages in a folder -usage: $Prog [options] [+folder] +Usage: $Prog [OPTIONS] [FOLDER] "; @OptConfig =( @@ -71,7 +70,7 @@ exit $EXIT_SUCCESS; ## ## Work horse ## -sub impack ($) { +sub impack($) { my $folder = shift; my $msg = 1; my $dst; @@ -89,7 +88,7 @@ sub impack ($) { do { $dst =~ s|[^/]+$|$msg++|e; } while ($_ ne $dst && -e $dst); - if ($_ ne $dst){ + if ($_ ne $dst) { im_rename($_, $dst) || die $@; # XXX } } @@ -99,6 +98,57 @@ sub impack ($) { touch_folder($folder) unless $opt_noharm; } +__END__ + +=head1 NAME + +impack - pack mail/news messages in a folder + +=head1 SYNOPSIS + +B<impack> [OPTIONS] [FOLDER] + +=head1 DESCRIPTION + +The I<impack> command packs mail/news messages in a folder. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER> + +Set source folder. Default value is "+inbox". +"--src=+xxx" is equivalent to "+xxx". + +=item I<-n, --noharm={on,off}> + +No packing. Show what will happen. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/impath.in b/img/dist/IM/impath.in index aa4909df..dfe6f308 100644 --- a/img/dist/IM/impath.in +++ b/img/dist/IM/impath.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "impath version 20000414(IM141)"; +my $VERSION = "impath version 20021207(IM142)"; $Prog = 'impath'; @@ -33,11 +33,10 @@ use vars qw($Prog $EXPLANATION @OptConfig ## Environments ## -$EXPLANATION = " -$Prog :: Internet Message Path -$VERSION +$EXPLANATION = "$VERSION +print full pathnames of a mail/news folder -usage: $Prog [options] [folder] +Usage: $Prog [OPTIONS] [FOLDER] "; @OptConfig =( @@ -111,7 +110,7 @@ exit $EXIT_SUCCESS; ## --path ## -sub show_path () { +sub show_path() { print "MailPath=" . mail_path() . "\n"; print "NewsPath=" . news_path() . "\n"; print "InboxFolder=" . inbox_folder() . "\n"; @@ -130,17 +129,17 @@ sub show_path () { ## --list ## -sub imfolders ($$) { - my ($folder, $prefix) = @_; +sub imfolders($$) { + my($folder, $prefix) = @_; $FOLDER_ROOT = get_impath($folder); $FOLDER_ROOT =~ s:/$::; dig_dir($FOLDER_ROOT, $prefix); } -sub dig_dir ($$) { - my ($abs_dir, $p) = @_; +sub dig_dir($$) { + my($abs_dir, $p) = @_; my @direntries; - my ($child, $rel_dir); + my($child, $rel_dir); opendir(DIR, $abs_dir); @direntries = sort(grep(-d "$abs_dir/$_" && $_ ne '.' && $_ ne '..', @@ -158,7 +157,7 @@ sub dig_dir ($$) { ### ### do things like mhpath. ### -sub impath ($@) { +sub impath($@) { my $folder = shift; my @msgs = @_; @@ -171,6 +170,62 @@ sub impath ($@) { } } +__END__ + +=head1 NAME + +impath - print full pathnames of a mail/news folder + +=head1 SYNOPSIS + +B<impath> [OPTIONS] [FOLDER] + +=head1 DESCRIPTION + +The I<impath> command expands a mail/news folder to a file path, +or list up folders. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER> + +Set source folder. Default value is "+inbox". +"--src=+xxx" is equivalent to "+xxx". + +=item I<-l, --list={on,off}> + +Show list of folders. + +=item I<-p, --path={on,off}> + +Show important paths. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/imput.in b/img/dist/IM/imput.in index 10f89655..7626daf4 100644 --- a/img/dist/IM/imput.in +++ b/img/dist/IM/imput.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Aug 31, 1995 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,32 +13,10 @@ BEGIN { @im_src_siteperl@ }; -$VERSION = "imput version 20000414(IM141)"; +$VERSION = "imput version 20021207(IM142)"; $Prog = 'imput'; -# Usage: -# o With UCB Mail -# define "sendmail" environment variable with value "imput". -# o With Mew -# eval (setq mew-prog-imput "imput") -# o With MH -# define sendproc in ~/.mh_profile like "sendproc: imput" -# o With sendmail.el (if you are using VM or ....) -# eval (setq sendmail-program "imput") -# o With mh-e (4 or later) -# eval (setq mh-send-prog "imput") -# o With pine -# define "sendmail-path" in ~/.pinerc, for example: -# sendmail-path=/usr/local/bin/imput -Report -ObeyHeader -IgnoreDot -# o With applications which use sendmail -# replace sendmail to this program but if daemon sendmail is required, -# original sendmail should be renamed to sendmail.bin or something else -# for starting daemon mode sendmail and for newaliasing -# o With applications which use inews -# header generation by command line option not supported - - require 5.003; use IM::Address; @@ -64,11 +42,10 @@ use vars qw($DebugAll $QueueStatus $Subject $Ignore_Dot $Fcc_partial $News_severe_check $PreserveMessage $Queuing $Comment_Name $Help $JustQueuing $Me_too $Dcc_Address $PGP_Sign); -$EXPLANATION = " -$Prog :: Put Messages into Networks -$VERSION +$EXPLANATION = "$VERSION +put mail/news message into networks -Usage: $Prog [options] msg +Usage: $Prog [OPTIONS] [MSG] "; # table of environment variables @@ -157,7 +134,8 @@ Usage: $Prog [options] msg 'JPconv;b;;Iso2022jp_code_conversion' => 'Convert japanese character encoding from EUC/SJIS to JIS.', 'DefCode;s;8BIT;Default_code' - => 'Default classification of japanese character code (EUC/SJIS/8BIT).', + => 'Default classification of japanese character code.' . + "\n\t\t(EUC/SJIS/8BIT)", 'JPheader;b;1;Iso2022jp_header_mime_conv' => 'Encode japanese JIS characters to MIME style at header.', 'HdrQEncoding;b;;HdrQEncoding' @@ -414,7 +392,7 @@ help($EXPLANATION) && exit $EXIT_SUCCESS if $Help; &init_final; - my ($h); + my($h); foreach $h (@Add_headers) { if ($h =~ /^([\w\-]+):\s*(.*)/s) { &add_header(\@Header, 0, $1, $2); @@ -661,7 +639,7 @@ help($EXPLANATION) && exit $EXIT_SUCCESS if $Help; if ($Me_too) { &error_exit if (&add_to_rcpt(0, $Sender) < 0); } - my ($d); + my($d); foreach $d (split(',', $Dcc_Address)) { &error_exit if (&add_to_rcpt(0, $d) < 0); } @@ -840,14 +818,14 @@ sub initialize { # user's information if (unixp()) { - my ($pw_name, $pw_passwd, $pw_uid, $pw_gid, $pw_quota, - $pw_comment, $pw_gcos, $pw_dir, $pw_shell) = getpwuid($<); + my($pw_name, $pw_passwd, $pw_uid, $pw_gid, $pw_quota, + $pw_comment, $pw_gcos, $pw_dir, $pw_shell) = getpwuid($<); $Home = $pw_dir; - local (@cap) = unpack('aa*', $pw_name); + local(@cap) = unpack('aa*', $pw_name); $cap[0] =~ tr/a-z/A-Z/; - local ($cap) = join('', @cap); + local($cap) = join('', @cap); if (!$Sender_name) { ($Sender_name = $pw_gcos) =~ s/,.*$//; $Sender_name =~ s/&/$cap/g; @@ -886,7 +864,7 @@ sub init_final { if ($Mail_Address ne '' && $Default_from_domain_name eq '') { my $a = &extract_addr($Mail_Address); if ($a =~ /(.*)\@(.*)/s) { - my ($u, $h) = ($1, $2); + my($u, $h) = ($1, $2); $Default_from_domain_name = $h; $User_name = $u unless ($User_name); } @@ -915,7 +893,7 @@ sub init_final { &log_transaction; # user's require file - if($User_require) { + if ($User_require) { require $User_require; } } @@ -932,8 +910,8 @@ sub init_final { # -1: unrecoverable error # sub send_message { - local ($news_flag, $split) = @_; - local ($normal, $bcc, $i, $rcode); + local($news_flag, $split) = @_; + local($normal, $bcc, $i, $rcode); # hook before dispatching the message &$Hook_PreDispatching if ($Hook_PreDispatching); @@ -1058,7 +1036,7 @@ sub send_message { # return value: none # sub smtp_get_mail { - local ($state) = 0; + local($state) = 0; print STDOUT "220 Server ready ($VERSION)\r\n"; while (<STDIN>) { if (/^NOOP\s/i) { @@ -1127,7 +1105,7 @@ sub smtp_get_mail { # return value: none # sub smtp_get_mail_final { - local ($error) = @_; + local($error) = @_; return unless (fileno(STDOUT)); unless ($error) { print STDOUT "250 Message accepted for delivery\n"; @@ -1167,9 +1145,9 @@ sub smtp_get_mail_final { # return value: none # sub read_message { - local ($dist_mode) = @_; - local ($message_file); - local (*READ); + local($dist_mode) = @_; + local($message_file); + local(*READ); if ($dist_mode) { $message_file = &expand_path($Dist_file); } else { @@ -1200,8 +1178,8 @@ sub read_message { # sub read_mp_message { (my $file, local *content) = @_; - local ($message_file); - local (*MP_READ); + local($message_file); + local(*MP_READ); if ($file eq '-') { $message_file = '/dev/tty'; # get from STDIN } else { @@ -1225,8 +1203,8 @@ sub read_mp_message { # return value: none # sub encapsulate_body { - local ($boundary) = @_; - local ($l); + local($boundary) = @_; + local($l); # unshift(@Body, "\n"); # pull down Content-* header lines into body part foreach $l (@Header) { @@ -1250,7 +1228,7 @@ sub encapsulate_body { # return value: none # sub add_multipart { - local ($part_code); + local($part_code); local($mp_boundary) = &gen_message_id(0); $mp_boundary =~ y/<@>/-_-/; &encapsulate_body($mp_boundary); @@ -1285,7 +1263,7 @@ sub add_multipart { ## endif } if ($part_code eq '8BIT') { - local ($part_encoding); + local($part_encoding); push(@Body, "Content-Type: Text/plain; " . "charset=$Unknown8bit_label\n"); if ($Conv_8to7) { @@ -1350,7 +1328,7 @@ sub pgp_process { . "for PGP PassPhrase passing\n") if (&debug('pgp')); - local ($f) = fork; + local($f) = fork; if ($f < 0) { im_err("Can not fork to exec PGP program.\n"); &error_exit; @@ -1438,9 +1416,9 @@ sub pgp_process { # path_of_file: success # sub save_fcc { - my ($folder, $dir_style, $total) = @_; - my ($fcc_dir, $err_remove, $i, $msg, $dead); - my ($FCC); + my($folder, $dir_style, $total) = @_; + my($fcc_dir, $err_remove, $i, $msg, $dead); + my($FCC); &set_crlf("\n"); $total = 0 unless ($Fcc_partial); if ($folder eq '') { @@ -1557,18 +1535,18 @@ sub trash_message { } my $message_file = &expand_path($d); if ($message_file =~ /^(.*\D)(\d+)$/) { - my ($dir, $file) = ($1, $2); + my($dir, $file) = ($1, $2); if ($Trashmark) { if (-f "$dir$Trashmark$file") { - unlink ("$dir$Trashmark$file"); + unlink("$dir$Trashmark$file"); } - if (!rename ("$dir$file", "$dir$Trashmark$file")) { + if (!rename("$dir$file", "$dir$Trashmark$file")) { im_err("Can not rename: $dir$file as $dir$Trashmark$file\n"); &error_exit; } - im_notice("$dir$file was renamed to $dir$Trashmark$file"); + im_notice("$dir$file was renamed to $dir$Trashmark$file\n"); } else { - unlink ("$dir$file"); + unlink("$dir$file"); } } } @@ -1585,8 +1563,8 @@ sub append_dist_header { } else { $d = $Draft_message; } - my ($message_file) = &expand_path($d); - local (*DIST); + my($message_file) = &expand_path($d); + local(*DIST); unless (im_open(\*DIST, "<$message_file")) { im_err("Can not open: $message_file\n"); &error_exit; @@ -1603,7 +1581,7 @@ sub append_dist_header { # return value: none # sub annotate { - my ($label, $ref) = @_; + my($label, $ref) = @_; local $_; im_notice("annotating messages ($ref).\n"); return if (history_open(0) < 0); @@ -1724,7 +1702,7 @@ sub annotate { return -1; } close(TMP); - unlink ($tmp); + unlink($tmp); } return 0; } @@ -1738,8 +1716,8 @@ sub annotate { # reutrn value: none # sub process_queue { - my ($queue_dir, $deliver) = @_; - my ($q, $found); + my($queue_dir, $deliver) = @_; + my($q, $found); unless ($deliver) { require IM::EncDec && import IM::EncDec; } @@ -1754,10 +1732,10 @@ sub process_queue { foreach $q (sort {$a <=> $b} readdir(QUEUEDIR)) { next unless ($q =~ /^\d+$/); # $QUEUE = 'QUEUE'; - rename ("$queue_dir/$q", "$queue_dir/$q.wrk"); + rename("$queue_dir/$q", "$queue_dir/$q.wrk"); unless (im_open(\*QUEUE, "<$queue_dir/$q.wrk")) { im_err("can't open $queue_dir/$q.wrk\n"); - rename ("$queue_dir/$q.wrk", "$queue_dir/$q"); + rename("$queue_dir/$q.wrk", "$queue_dir/$q"); return; } im_notice("processing $queue_dir/$q.wrk ...\n"); @@ -1796,7 +1774,7 @@ sub process_queue { unlink("$queue_dir/$q.wrk"); im_info("$queue_dir/$q: sent\n"); } elsif ($rcode > 0) { - rename ("$queue_dir/$q.wrk", "$queue_dir/$q"); + rename("$queue_dir/$q.wrk", "$queue_dir/$q"); im_info("$queue_dir/$q: preserved\n"); } else { unlink("$queue_dir/$q.wrk"); @@ -1804,8 +1782,8 @@ sub process_queue { &error_report; } } else { - my ($r, $t); - rename ("$queue_dir/$q.wrk", "$queue_dir/$q"); + my($r, $t); + rename("$queue_dir/$q.wrk", "$queue_dir/$q"); print "Message queued in $queue_dir/$q"; if ($Config_opt ne '') { print " (Config: $Config_opt)\n"; @@ -1858,9 +1836,9 @@ sub process_queue { # 0: success # sub queue_message { - local ($queue_dir, *Header, *Body) = @_; - my ($q); - local (*QUEUE); + local($queue_dir, *Header, *Body) = @_; + my($q); + local(*QUEUE); unless (-d $queue_dir) { unless (mkdir($queue_dir, &folder_mode(0))) { im_err("can't create directory $queue_dir\n"); @@ -1880,7 +1858,7 @@ sub queue_message { } closedir(QUEUEDIR); $max++; - my ($fail_cnt) = 0; + my($fail_cnt) = 0; im_notice("QUEUE creating $queue_dir/$max\n"); msg_mode(1); while (&excl_create(\*QUEUE, "$queue_dir/$max") < 0) { @@ -1933,8 +1911,8 @@ sub queue_message { # error_report() # sub error_report { - my ($rc); - local ($errlog) = &im_saved_errors(); + my($rc); + local($errlog) = &im_saved_errors(); # reset the server list @Smtp_servers = split(',', $Smtp_servers); push(@Smtp_servers, split(',', $Emg_Smtp_servers)); @@ -1965,11 +1943,11 @@ sub error_report { # error_exit() # sub error_exit { - local ($rc); + local($rc); # if (!$Error_report_by_mail && !$Smtp_input_mode) { # $Error_report_by_mail = 1 unless (-t STDERR); # unless TTY # } - local ($errlog) = &im_saved_errors(); + local($errlog) = &im_saved_errors(); if ($Error_report_by_mail) { # reset the server list @Smtp_servers = split(',', $Smtp_servers); @@ -2058,7 +2036,7 @@ sub error_exit { # stat: exit status # sub exit_ { - local ($stat) = @_; + local($stat) = @_; &smtp_close; &nntp_close; exit $stat; @@ -2081,6 +2059,488 @@ sub exit_ { # @HOSTNAME@ # sgid mail +__END__ + +=head1 NAME + +imput - put mail/news message into networks + +=head1 SYNOPSIS + +B<imput> [OPTIONS] [MSG] + +=head1 DESCRIPTION + +The I<imput> command dispatches mail/news message by way of SMTP/NNTP. + +This command is provided by IM (Internet Message). + +=over 5 + +=item With UCB Mail + +Define "sendmail" environment variable with value "imput". + +=item With Mew + +Eval (setq mew-prog-imput "imput"). + +=item With MH + +Define sendproc in ~/.mh_profile like "sendproc: imput". + +=item With sendmail.el (if you are using VM or ....) + +Eval (setq sendmail-program "imput"). + +=item With mh-e (4 or later) + +Eval (setq mh-send-prog "imput"). + +=item With pine + +Define "sendmail-path" in ~/.pinerc, for example: + +sendmail-path=/usr/local/bin/imput -Report -ObeyHeader -IgnoreDot + +=item With applications which use sendmail + +Replace sendmail to this program but if daemon sendmail is required, +original sendmail should be renamed to sendmail.bin or something else +for starting daemon mode sendmail and for newaliasing. + +=item With applications which use inews + +Header generation by command line option not supported. + +=back + +=head1 OPTIONS + +=over 5 + +=item I<--help> + +Display help message and exit. + +=item I<--debug={on,off}> + +Set all debug options. + +=item I<--debugflag=DEBUG_OPTION> + +Set specific debug options (separated with ','). + +=item I<--verbose={on,off}> + +Print verbose messages when running. + +=item I<--require=STRING> + +User defined perl script to be required. + +=item I<--smtpservers=STRING> + +List of SMTP servers (separated with ','). + +Each element should be server[/remote_port][%local_port] + +=item I<--emgsmtpsvrs=STRING> + +List of SMTP servers for Emergency Use (i.e. error reporting). + +=item I<--trynextonfatal={on,off}> + +Try next SMTP server evenif permanent failure. + +=item I<--nntpservers=STRING> + +List of NNTP servers (separated with ','). + +Each element should be server[/remote_port][%local_port] + +=item I<--nntpauthuser=STRING> + +User name for NNTP authentication. + +=item I<--clientname=STRING> + +Name as a SMTP client (used for SMTP HELO). + +=item I<--sshserver=STRING> + +SSH port relay server. + +=item I<--obeymtadomain={on,off}> + +Do not qualify local addresses with default domain. + +=item I<--fromdomain=STRING> + +Default domain name for sender. + +=item I<--todomain=STRING> + +Default domain name for recipients. + +=item I<--msgiddomain=STRING> + +Default domain name for Message-Id generation. + +=item I<--nomsgidfornews=STRING> + +Strip Message-Id when posting to news system. + +=item I<--user=STRING> + +Local part of the sender address. + +=item I<--address=STRING> + +Address used in From: header; equivalent to User@FromDomain + +=item I<--name=STRING> + +Commentary name for sender. + +=item I<--nameincomment={on,off}> + +Show commentary name in () on From: header. + +=item I<--org=STRING> + +Name of organization for news posting. + +=item I<--subj=STRING> + +A string for subject field. + +=item I<--nscmpl={on,off}> + +Use domain-part completion with nameserver. + +=item I<--showrcpts={on,off}> + +Allow to show recipients in header as To: if no To: in original. + +=item I<--metoo={on,off}> + +Request DCC to me. + +=item I<--dcc=STRING> + +Supplemental DCC address. + +=item I<--fcc=STRING> + +Folder name to save FCC. + +=item I<--receipt={on,off}> + +Need a report of successful delivery. + +=item I<--group=STRING> + +Newsgroup names to be posted in. + +=item I<--jpconv={on,off}> + +Convert japanese character encoding from EUC/SJIS to JIS. + +=item I<--defcode=STRING> + +Default classification of japanese character code (EUC/SJIS/8BIT). +Default value is "8bit". + +=item I<--jpheader={on,off}> + +Encode japanese JIS characters to MIME style at header. +Default value is "on". + +=item I<--hdrqencoding={on,off}> + +Header encoding type: 0 is B; 1 is Q. + +=item I<--nohdrfolding={on,off}> + +Do not fold long header lines. + +=item I<--sortheader=STRING> + +Header sequence for sorting (labels separated with ','). + +=item I<--8to7={on,off}> + +Convert 8bit body to 7bit by base64/quoted-printable encoding. + +=item I<--8bitlabel=STRING> + +Sub-type label for unknown 8bit body on Content-Type:. +Default value is "unknown-8bit". + +=item I<--lines=NUM> + +Line numbers for splitting into partial messages. + +=item I<--sleep=NUM> + +Sleep interval for dispatching each splitted messages. +Default value is 10. + +=item I<--log=STRING> + +File name to write delivery log. +Default value is "putlog". + +=item I<--syslog={on,off}> + +Use SYSLOG feature instead of writing to a file directly. + +=item I<--report={on,off}> + +Report errors via mail. +Default value is "on". + +=item I<--msgid={on,off}> + +Generate Message-Id header line. +Default value is "on". + +=item I<--pidmsgid={on,off}> + +Generate Message-Id with Process ID. + +=item I<--uidmsgid={on,off}> + +Generate Message-Id with User ID instead of login name. + +=item I<--date={on,off}> + +Generate Date header line. +Default value is "on". + +=item I<--newsgmtdate={on,off}> + +Generate date field in GMT for posting news. + +=item I<--uselines={on,off}> + +Generate Lines header line. +Default value is "on". + +=item I<--aliasesfile=STRING> + +List of files for mail address aliasing. +Default value is "Aliases". + +=item I<--addrbook=STRING> + +List of Addrbook files. + +=item I<--hostaliases=STRING> + +List of files for domain part completion. + +=item I<--fccpartial={on,off}> + +Save FCC with partial format. + +=item I<--dead=STRING> + +Path of file to save unsent message as a deadletter. +Default value is "dead.letter". + +=item I<--justqueuing={on,off}> + +Just store message into queue without attempt of delivery. + +=item I<--queuing={on,off}> + +Store message into queue on delivery failure. + +=item I<--processqueue={on,off}> + +Process queued messages. + +=item I<--queuestatus={on,off}> + +Show list of queued messages. + +=item I<--folder=STRING> + +Path of draft folder directory. + +=item I<--mimebcc={on,off}> + +Use MIME (message/rfc822) style BCC. +Default value is "on". + +=item I<--trashmark=STRING> + +Prefix character for draft message file renaming. +Default value is "#". + +=item I<--preserve={on,off}> + +Preserve draft message as is even if dispatched successfully. + +=item I<--message=STRING> + +Path/name of draft message. + +=item I<--pgpsign={on,off}> + +Generate PGP signature for body-part. + +=item I<--multipartadd=STRING,STRING...> + +Path/name of message to be added as a part of multipart message. + +=item I<--filenameadd={on,off}> + +Add filename field at Content-Disposition header. + +=item I<--smtp={on,off}> + +Perform SMTP style input mode. + +=item I<--annotate={on,off}> + +Annotate on the parent message (MsgDB required). + +=item I<--dist={on,off}> + +Redistribution mode (using Resent-*:). + +=item I<--distmsg=STRING> + +Path of message for redistribution. + +=item I<--obeyheader={on,off}> + +Collect recipients from message header. + +=item I<--ignoredot={on,off}> + +Ignore DOT for message termination. + +=item I<--newscheck={on,off}> + +No news posting if To, Cc header found evenif Newsgroups: exists. + +=item I<--esmtp={on,off}> + +Enforce ESMTP (always begins with EHLO). + +=item I<--newspost={on,off}> + +Enable NNTP. +Default value is "on". + +=item I<--addheader=STRING,STRING...> + +Header lines to be added. + +=back + +For compatibility with the send command (provided by MH/nmh): + + -mime=<on|off> (on) + + -watch=<on|off> (off) + + -draftmessage=<string> () + + -draftf=<string> () + + -verbose=<on|off> (off) + + -draftfolder=<string> () + + -nowatch=<on|off> (off) + + -nodraftfolder=<string> () + + -draftm=<string> () + + -draft=<on|off> (off) + + -alias=<string> (Aliases) + + -aliasesfile=<string> (Aliases) + + -filter=<string> () + + -nofilter=<on|off> (off) + + -format=<on|off> (off) + + -noformat=<on|off> (off) + + -forward=<on|off> (off) + + -noforward=<on|off> (off) + + -push=<on|off> (on) + + -nopush=<on|off> (on) + + -width=<num> () + + -library=<string> () + + -hencode=<on|off> (on) + + -nohencode=<on|off> (on) + + -split=<num> (10) + + -server=<string> (localhost) + + -client=<string> (localhost) + + -bs=<on|off> (off) + + -f=<string> () + + -t=<on|off> (off) + + -v=<on|off> (off) + + -odb=<on|off> (off) + + -odi=<on|off> (off) + + -oem=<on|off> (on) + + -oi=<on|off> (off) + + -i=<on|off> (off) + + -om=<on|off> (off) + + -m=<on|off> (off) + + -odq=<on|off> (off) + + -q=<on|off> (off) + + -bp=<on|off> (off) + + -J=<on|off> (off) + + -h=<on|off> (off) + + -s=<string> () + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/impwagent.in b/img/dist/IM/impwagent.in index 578b6c7a..1090cf6b 100644 --- a/img/dist/IM/impwagent.in +++ b/img/dist/IM/impwagent.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Sep 13, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "impwagent version 20000414(IM141)"; +my $VERSION = "impwagent version 20021207(IM142)"; $Prog = 'impwagent'; @@ -44,7 +44,7 @@ if ($ARGV[0] =~ /stop|quit/i) { } else { print "$Prog: exit message: $res\n"; } - exit 0; + exit $EXIT_SUCCESS; } # clear password cache @@ -56,25 +56,29 @@ if ($ARGV[0] =~ /clear/i) { } else { print "$Prog: exit message: $res\n"; } - exit 0; + exit $EXIT_SUCCESS; } if ($ARGV[0] !~ /start/i && @ARGV > 0) { print <<EOF; -$Prog: IM Password Agent -- hold passwords to reuse on later sessions. +$VERSION +hold passwords for IM Usage: - $Prog help show this message - $Prog [start] start $Prog - $Prog stop/quit terminate $Prog - $Prog clear clear passwords held by $Prog + $Prog [start] start $Prog + $Prog stop/quit terminate $Prog + $Prog clear clear passwords held by $Prog + $Prog help show this message + +This command holds passwords to reuse on later sessions for IM. If you wish to use the feature supplied by $Prog, put "UsePwAgent=yes" -in your Config file, and start $Prog manually before using IM-commands +in your Config file, and start $Prog manually before using im* commands which require passwords. +Report bugs to <img\@mew.org> EOF - exit 0; + exit $EXIT_SUCCESS; } # duplicate check @@ -82,60 +86,53 @@ $res = &connect_agent(1); $res = &talk_agent("PING\n") if ($res ne ''); if ($res eq 'PONG') { print STDERR "$Prog: already running.\n"; - exit 1; + exit $EXIT_ERROR; } # preparing socket directory my $realuser = im_getlogin(); unless ($realuser) { print STDERR "$Prog: can not get login name.\n"; - exit 1; + exit $EXIT_ERROR; } - -my $dir = "/tmp/im-$realuser"; +my $dir = &pwagent_tmp_path() . "-$realuser"; my $port = &pwagentport(); if ($port > 0) { - rmdir ($dir); - - if (-e $dir) { - print STDERR "$Prog: can not re-create directory: $dir.\n"; - exit 1; + rmdir $dir; + unless (mkdir($dir, 0700)) { + print STDERR "$Prog: can not create directory: $dir.\n"; + exit $EXIT_ERROR; } - mkdir ($dir, 0700); - unless (socket(SOCK, &AF_INET, &SOCK_STREAM, 0)) { print STDERR "$Prog: socket: $!\n"; - exit 1; + exit $EXIT_ERROR; } my $sin = sockaddr_in($port, inet_aton('127.0.0.1')); unless (bind(SOCK, $sin)) { print STDERR "$Prog: bind: $!\n"; - exit 1; + exit $EXIT_ERROR; } } else { $sockname = "$dir/pw"; # be sure the dir is not a link - unlink ($sockname); - rmdir ($dir); - - if (-e $dir) { - print STDERR "$Prog: can not re-create directory: $dir.\n"; - exit 1; + unlink $sockname; + rmdir $dir; + unless (mkdir($dir, 0700)) { + print STDERR "$Prog: can not create directory: $dir.\n"; + exit $EXIT_ERROR; } - mkdir ($dir, 0700); - unless (socket(SOCK, &AF_UNIX, &SOCK_STREAM, 0)) { print STDERR "$Prog: socket: $!\n"; - exit 1; + exit $EXIT_ERROR; } my $sun = sockaddr_un($sockname); unless (bind(SOCK, $sun)) { print STDERR "$Prog: bind: $!\n"; - exit 1; + exit $EXIT_ERROR; } chmod(0600, $sockname); @@ -150,12 +147,12 @@ $SIG{'ALRM'} = \&alarm_func; my $id = fork(); if ($id < 0) { print STDERR "$Prog: can not fork: $!\n"; - exit 1; + exit $EXIT_ERROR; } if ($id) { print STDERR "$Prog: started (pid: $id)\n"; - exit 0; + exit $EXIT_SUCCESS; } chdir($dir); @@ -169,11 +166,11 @@ my $key = pack('C2', @_); for (;;) { unless (accept(REQ, SOCK)) { print STDERR "$Prog: accept: $!\n"; - exit 1; + exit $EXIT_ERROR; } if ($port > 0) { my $sa = getpeername(REQ); - my ($fa, $po, $ad) = sockaddr_in($sa); + my($fa, $po, $ad) = sockaddr_in($sa); next if ($ad != inet_aton('127.0.0.1')); } select(REQ); $| = 1; select(STDOUT); @@ -207,21 +204,76 @@ for (;;) { } else { # protocol error (including QUIT) print REQ "BYE\n"; - shutdown (REQ, 2); - close (REQ); - close (SOCK); - unlink ($sockname) if ($sockname); - exit 1; + shutdown(REQ, 2); + close(REQ); + close(SOCK); + unlink($sockname) if ($sockname); + rmdir $dir; + exit $EXIT_ERROR; } substr($_, 0, length($_)) = '0123456789abcdef'; - shutdown (REQ, 2); - close (REQ); + shutdown(REQ, 2); + close(REQ); } sub alarm_func { # no operation } +__END__ + +=head1 NAME + +impwagent - hold passwords for IM + +=head1 SYNOPSIS + +B<impwagent> [start | stop | quit | clear | help] + +=head1 DESCRIPTION + +The I<impwagent> command holds passwords to reuse on later +sessions for IM. + +If you wish to use the feature supplied by impwagent, put + + UsePwAgent=yes + +in your Config file, and start impwagent manually before using im* commands +which require passwords. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<start> + +Start impwagent. This is the default behavior. + +=item I<stop>, I<quit> + +Terminate impwagent. + +=item I<clear> + +Clear passwords held by impwagent. + +=item I<help> + +Show help message. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/imrm.in b/img/dist/IM/imrm.in index dd12dea2..74954469 100644 --- a/img/dist/IM/imrm.in +++ b/img/dist/IM/imrm.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imrm version 20000414(IM141)"; +my $VERSION = "imrm version 20021207(IM142)"; $Prog = 'imrm'; @@ -39,22 +39,21 @@ use vars qw($Prog $EXPLANATION @OptConfig my %NewMsgCache = (); -$EXPLANATION = " -$Prog :: Internet Message Remove -$VERSION +$EXPLANATION = "$VERSION +remove mail/news messages -Usage: $Prog [options] +folder... msgs... +Usage: $Prog [OPTIONS] FOLDER... MSGS... "; @OptConfig = ( 'src;F;;' => "Set source folder.", 'dst;f@;;' => "Set destination folder.", + 'SSHServer,S;s;localhost;SSH_server' + => 'SSH port relay server.', 'noharm;b;;' => "Display the commands but do not actually execute them.", 'verbose;b;;' => 'With verbose messages.', 'debug;d;;' => "With debug message.", 'help;b;;' => "Show this message.", - 'SSHServer,S;s;localhost;SSH_server' - => 'SSH port relay server.', ); ## @@ -85,10 +84,10 @@ exit $EXIT_SUCCESS; ## ## Work horse ## -sub imrm ($$$) { - my ($src, $dsts, $msgs) = @_; - my (@imap_dsts, @local_dsts); - my ($imap_src, $imap_dst, $news_src, $news_dst) = (0, 0, 0, 0); +sub imrm($$$) { + my($src, $dsts, $msgs) = @_; + my(@imap_dsts, @local_dsts); + my($imap_src, $imap_dst, $news_src, $news_dst) = (0, 0, 0, 0); if ($src =~ /^-/) { $news_src = 1; @@ -145,7 +144,7 @@ sub imrm ($$$) { } sub local2local($$$) { - my ($src, $dsts, $msgs) = @_; + my($src, $dsts, $msgs) = @_; my @msg_paths = get_impath($src, @$msgs); foreach (@msg_paths) { @@ -154,8 +153,8 @@ sub local2local($$$) { } sub imap2local($$$) { - my ($src, $dsts, $msgs) = @_; - my ($msg, $Message); + my($src, $dsts, $msgs) = @_; + my($msg, $Message); foreach $msg (@$msgs) { $Message = imap_get_message($src, $msg); @@ -165,8 +164,8 @@ sub imap2local($$$) { } sub news2local($$$) { - my ($src, $dsts, $msgs) = @_; - my ($msg, $rc, $Message); + my($src, $dsts, $msgs) = @_; + my($msg, $rc, $Message); foreach $msg (@$msgs) { ($rc, $Message) = nntp_get_message($src, $msg); @@ -175,12 +174,12 @@ sub news2local($$$) { } } -sub refile_one ($$$) { - my ($src, $dsts, $msg) = @_; - my ($dst, $dst_path, $link_it); +sub refile_one($$$) { + my($src, $dsts, $msg) = @_; + my($dst, $dst_path, $link_it); foreach $dst (@{$dsts}) { - if ($NewMsgCache{$dst}){ + if ($NewMsgCache{$dst}) { $NewMsgCache{$dst} =~ s|([^/]+)$|$1+1|e; # increment cache $dst_path = $NewMsgCache{$dst}; } else { @@ -202,8 +201,8 @@ sub refile_one ($$$) { } } -sub local2imap ($$$) { - my ($src, $dsts, $msgs) = @_; +sub local2imap($$$) { + my($src, $dsts, $msgs) = @_; my $msg; foreach $msg (@$msgs) { @@ -215,9 +214,9 @@ sub local2imap ($$$) { } } -sub news2imap ($$$) { - my ($src, $dsts, $msgs) = @_; - my ($msg, $rc, $Message); +sub news2imap($$$) { + my($src, $dsts, $msgs) = @_; + my($msg, $rc, $Message); foreach $msg (@$msgs) { ($rc, $Message) = nntp_get_message($src, $msg); @@ -226,20 +225,80 @@ sub news2imap ($$$) { } } -sub imap2imap ($$$) { +sub imap2imap($$$) { imap_refile(@_); } -sub uniq (@) { +sub uniq(@) { my @array = @_; my %hash; - foreach (@array){ + foreach (@array) { $hash{$_} = $_; } return keys(%hash); } +__END__ + +=head1 NAME + +imrm - remove mail/news messages + +=head1 SYNOPSIS + +B<imrm> [OPTIONS] FOLDER... MSGS... + +=head1 DESCRIPTION + +The I<imrm> command moves mail/news messages from the source folder to +the +trash folder. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER> + +Set source folder. Default value is "+inbox". +"--src=+xxx" is equivalent to "+xxx". + +=item I<-d, --dst=FOLDER> + +Set destination folder. Default value is "+trash". + +=item I<-S, --sshserver=SERVER> + +SSH port relay server. + +=item I<-n, --noharm={on,off}> + +Display the commands but do not actually execute them. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/imsetup.in b/img/dist/IM/imsetup.in index 724cb34e..78695606 100644 --- a/img/dist/IM/imsetup.in +++ b/img/dist/IM/imsetup.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: May 9, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imsetup version 20000414(IM141)"; +my $VERSION = "imsetup version 20021207(IM142)"; $Prog = 'imsetup'; @@ -49,17 +49,16 @@ my $nosync; my $src = "local"; my $mailbox_style = "mbox"; my $auth = ""; -my ($user, $host) = split(/\@/, $address); +my($user, $host) = split(/\@/, $address); my $keep = 0; my $smtpserver = "localhost"; -my ($mhdir, $mhalias, $domain, $nntpservers); +my($mhdir, $mhalias, $domain, $nntpservers); -$EXPLANATION = " -$Prog :: Setup command for IM series -$VERSION +$EXPLANATION = "$VERSION +setup for IM -Usage :: $Prog [options] +Usage: $Prog [Options] "; @OptConfig = ( @@ -94,10 +93,10 @@ $nosync = no_sync() ? 'yes' : 'no'; &make_conf_file(); ©_alias_file(); -sub get_domain_name () { +sub get_domain_name() { my $hostname = hostname(); unless ($hostname =~ /\./) { - my ($h) = gethostbyname($hostname); + my($h) = gethostbyname($hostname); $hostname = $h if ($h); } $hostname =~ s/^[^.]+\.//; @@ -105,7 +104,7 @@ sub get_domain_name () { return $hostname; } -sub read_conf () { +sub read_conf() { $home = &input_config("Where is your home directory?", $home); &scan_mh_conf(); @@ -116,7 +115,7 @@ sub read_conf () { do { do { $mymail = &input_config("Where is your Mail directory?", $mymail); - } until (($mail = $mymail) =~ s!^$qhome/!!e + } until (($mail = $mymail) =~ s!^$qhome/!! || &input_confirm("Sure to use $mail which is not beneath " . "your home directory?")); } while (! &check_and_create_directory($mymail)); @@ -124,7 +123,7 @@ sub read_conf () { do { do { $mynews = &input_config("Where is your News directory?", $mynews); - } until (($news = $mynews) =~ s!^$qhome/!!e + } until (($news = $mynews) =~ s!^$qhome/!! || &input_confirm("Sure to use $news which is not beneath " . "your home directory?")); } while (! &check_and_create_directory($mynews)); @@ -187,8 +186,8 @@ sub read_conf () { print "\n"; } -sub input_config ($$) { - my ($msg, $default) = @_; +sub input_config($$) { + my($msg, $default) = @_; my $ret; print "$msg [$default] "; @@ -198,7 +197,7 @@ sub input_config ($$) { } sub input_confirm($;$) { - my ($msg, $default) = @_; + my($msg, $default) = @_; my $ret; $default = "yes" if $default eq ""; @@ -209,11 +208,11 @@ sub input_confirm($;$) { return $ret =~ m/^y/i; } -sub scan_mh_conf () { +sub scan_mh_conf() { my $mh_profile = "$home/.mh_profile"; - if ( -f $mh_profile ) { + if (-f $mh_profile) { open(MH_PROFILE, $mh_profile); - while(<MH_PROFILE>) { + while (<MH_PROFILE>) { chomp; if (/^Path:\s*(.*)/i) { $mhdir = $mail = $1; @@ -235,8 +234,8 @@ sub scan_mh_conf () { } } -sub check_im_directory () { - if ( -x "$home/$imdir" ) { +sub check_im_directory() { + if (-x "$home/$imdir") { print "$home/$imdir is already exist.\n"; } else { if (!$opt_noharm) { @@ -248,10 +247,10 @@ sub check_im_directory () { } } -sub check_and_create_directory ($) { +sub check_and_create_directory($) { my $dir = shift; - if ( ! -x $dir ) { + if (! -x $dir) { if (&input_confirm("$dir does not exist. Create it?")) { print "Creating $dir directory.\n"; if (!$opt_noharm) { @@ -269,15 +268,15 @@ sub check_and_create_directory ($) { return 1; } -sub copy_alias_file () { +sub copy_alias_file() { my $im_alias = "$home/$imdir/$alias"; my $mh_alias = "$home/$mhdir/$mhalias"; - if ( ! -f $mh_alias ) { + if (! -f $mh_alias) { $mh_alias = $mhalias; } - if ( -f $mh_alias && ! -f $im_alias ) { + if (-f $mh_alias && ! -f $im_alias) { print "Copy $mh_alias to $im_alias.\n"; if (!$opt_noharm) { copy($mh_alias, $im_alias); @@ -285,10 +284,10 @@ sub copy_alias_file () { } } -sub make_conf_file () { +sub make_conf_file() { my $im_config = "$home/$imdir/$config"; - if ( -f $im_config ) { + if (-f $im_config) { print "Backup $im_config to $im_config.bak.\n"; if (!$opt_noharm) { rename ("$im_config", "$im_config.bak"); @@ -430,6 +429,7 @@ keep=$keep #Imget.Src=local:\${HOME}/Maildir # in case of qmail UseCL=$usecl # Use value of Content-Length header NoSync=$nosync # Do not need fsync(2) on writing file +#FsyncNumber=118 # system call number of fsync --- if ($src =~ /^pop/i) { @@ -464,14 +464,19 @@ keep=$keep #HttpProxy=proxy-server:8080 # proxy server for HTTP access #NoProxy=http://.*my.domain/ # URL regex not to use Proxy server #UsePwAgent=yes # use password agent -#PwAgentPort=6543 # Port to connect pwagent with TCP/IP - # (Insecure for multi-user system!) - # 0 to use UNIX domain socket (more secure) +#PwAgentPort=0 # Port to connect pwagent with TCP/IP + # 0 to use UNIX domain socket + # NOTE: non-0 (e.g. 6543) is insecure + # on multi-user system +#PwAgentTmpDir=pwagtmp # temporary directory (relative to ~/.im/) # be careful on security if you wish to use PwFiles! #UsePwFiles=yes # use password files #PwFiles=password # password files (relative to ~/.im/) +#NamazuV2=yes # use Namazu version 2 (1.9.x or late) +#NamazuLockDir=nmzlock # lock directory (relative to ~/.im/) + ## imput specific #FccDir=\$MailDir # directory for FCC folders #QueueDir=queue # directory for to store messages to be sent @@ -515,6 +520,48 @@ keep=$keep } } +__END__ + +=head1 NAME + +imsetup - setup for IM + +=head1 SYNOPSIS + +B<imsetup> [OPTIONS] + +=head1 DESCRIPTION + +The I<imsetup> command is a setup program for IM. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-f, --fromdomain=STRING> + +Default domain name for mail address. + +=item I<-n, --noharm={on,off}> + +Do execute setup, show what will be performed. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/imsort.in b/img/dist/IM/imsort.in index f9a3d49d..29496cf0 100644 --- a/img/dist/IM/imsort.in +++ b/img/dist/IM/imsort.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Jul 2, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imsort version 20000414(IM141)"; +my $VERSION = "imsort version 20021207(IM142)"; $Prog = 'imsort'; @@ -35,11 +35,10 @@ use vars qw($Prog $EXPLANATION @OptConfig ## Environments ## -$EXPLANATION = " -$Prog :: Internet Message Sort -$VERSION +$EXPLANATION = "$VERSION +sort mail/news messages -Usage: $Prog [options] +folder [msgs...] +Usage: $Prog [OPTIONS] FOLDER [MSGS...] "; @OptConfig = ( @@ -91,7 +90,7 @@ my %MONTH = ('Jan', 1, 'Feb', 2, 'Mar', 3, 'Apr', 4, 'May', 5, 'Jun', 6, 'Jul', 7, 'Aug', 8, 'Sep', 9, 'Oct', 10, 'Nov', 11, 'Dec', 12); -sub rxp_or { join('|', @_); } +sub rxp_or { join('|', @_); } my $m_rxp = rxp_or(keys(%MONTH)); my $z_rxp = rxp_or(keys(%ZONE), '[-+]\d{4}'); @@ -106,9 +105,9 @@ exit $EXIT_SUCCESS; ## Work horse ## -sub imsort ($$$$) { - my ($src, $msgs, $mode, $field) = @_; - my ($i, $path, $from, $to, $tmp, @msg_all, @msg_paths, @sorted_index); +sub imsort($$$$) { + my($src, $msgs, $mode, $field) = @_; + my($i, $path, $from, $to, $tmp, @msg_all, @msg_paths, @sorted_index); my @param = (); my $HOLE_PATH = get_impath($src, 'new'); @@ -151,13 +150,13 @@ sub imsort ($$$$) { touch_folder($src) unless $opt_noharm; } -sub get_field_value ($$$) { - my ($path, $field, $smode) = @_; +sub get_field_value($$$) { + my($path, $field, $smode) = @_; local $_; local $/ = ''; - my ($ml, $num); + my($ml, $num); - if (im_open(\*MSG, "< $path")){ + if (im_open(\*MSG, "< $path")) { ($_ = <MSG>) =~ s/\n\s+/ /g; close(MSG); } else { @@ -167,7 +166,7 @@ sub get_field_value ($$$) { ($_) = /^$field:\s+([^\n]*)/imo; if (lc($field) eq 'subject') { if ($smode eq 'ml') { - if(s/^[\[\(]([^\]\)]*)[\]\)]\s*//i){ + if (s/^[\[\(]([^\]\)]*)[\]\)]\s*//i) { $1 =~ /^(.*)[:,\s](.*)$/; $ml=$1; $num=$2; s/^(re:\s*)(.*)$/$2$1/i; $_ = $ml . $_ . $num; @@ -180,8 +179,8 @@ sub get_field_value ($$$) { m/(\d+)\D*$/; $_ = $1; } - if ($smode eq 'date'){ - if (/(\d+)\s+($m_rxp)\s+(\d+)\s+(\d+):(\d+)(:(\d+))?\s*($z_rxp)?/io){ + if ($smode eq 'date') { + if (/(\d+)\s+($m_rxp)\s+(\d+)\s+(\d+):(\d+)(:(\d+))?\s*($z_rxp)?/io) { ## Y2K: conform to drums if ($3 < 50) { return sec_from_epoc($3 + 2000, $MONTH{$2}, $1, @@ -199,8 +198,8 @@ sub get_field_value ($$$) { return $_; } -sub sec_from_epoc ($$$$$$$) { - my ($y, $m, $d, $hh, $mm, $ss, $tz) = @_; +sub sec_from_epoc($$$$$$$) { + my($y, $m, $d, $hh, $mm, $ss, $tz) = @_; $tz = ($ZONE{$tz} * 3600) || (int($tz/100)*3600 + ($tz%100)*60); @@ -209,6 +208,65 @@ sub sec_from_epoc ($$$$$$$) { * 86400 + $hh * 3600 + $mm * 60 + $ss - $tz; } +__END__ + +=head1 NAME + +imsort - sort mail/news messages + +=head1 SYNOPSIS + +B<imsort> [OPTIONS] FOLDER [MSGS...] + +=head1 DESCRIPTION + +The I<imsort> command sorts mail/news messages in a folder. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER> + +Set source folder. Default value is "+inbox". +"--src=+xxx" is equivalent to "+xxx". + +=item I<-f, --field=STRING> + +Sort by the specified field. Default value is "date". + +=item I<-m, --mode=STRING> + +Set sort mode to date, num, text or ml. Default value is "date". + +=item I<-n, --noharm={on,off}> + +Display the commands but do not actually execute them. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/imstore.in b/img/dist/IM/imstore.in index 34689cd7..6de905ec 100644 --- a/img/dist/IM/imstore.in +++ b/img/dist/IM/imstore.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Dec 31, 1995 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imstore version 20000414(IM141)"; +my $VERSION = "imstore version 20021207(IM142)"; $Prog = 'imstore'; @@ -29,11 +29,10 @@ use vars qw($Prog $EXPLANATION @OptConfig ## Environments ## -$EXPLANATION = " -$Prog :: Internet Message Store -$VERSION +$EXPLANATION = "$VERSION +store mail/news message to a folder -Usage :: $Prog [options] +Usage: $Prog [OPTIONS] "; @OptConfig = ( @@ -56,11 +55,11 @@ debug_option($opt_debug) if $opt_debug; &process_stdin(); -sub process_stdin () { +sub process_stdin() { my @Message = (); while (<STDIN>) { - push (@Message, $_); + push(@Message, $_); } &store_message(\@Message, $opt_dst, 1); @@ -71,31 +70,39 @@ __END__ =head1 NAME -imstore - Store a message to a folder +imstore - store mail/news message to a folder =head1 SYNOPSIS -B<imstore> [B<--dst=+folder>] [B<--help>] +B<imstore> [OPTIONS] =head1 DESCRIPTION -I<Imstore> get a message from the standard input into an IM folder. -If `--dst=+folder' isn't specified, +inbox is assumed as the folder. -The new message being incorporated is assigned the next highest number -in the folder. +The I<imstore> command get mail/new message from the standard +input into a folder. The new message being incorporated is +assigned the next highest number in the folder. + +This command is provided by IM (Internet Message). =head1 OPTIONS =over 5 -=item I<-d, --dst = +folder> +=item I<-d, --dst=FOLDER> + +Set target folder. Default value is "+inbox". + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> -Use I<+folder> as a target folder. -Default is +inbox. +Print debug messages when running. =item I<-h, --help> -Print a usage message on standard output and exit successfully. +Display help message and exit. =back diff --git a/img/dist/IM/imtar.in b/img/dist/IM/imtar.in index 84dbea98..7ab07717 100644 --- a/img/dist/IM/imtar.in +++ b/img/dist/IM/imtar.in @@ -5,7 +5,7 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 08, 1998 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### BEGIN { @@ -13,7 +13,7 @@ BEGIN { @im_src_siteperl@ }; -my $VERSION = "imtar version 20000414(IM141)"; +my $VERSION = "imtar version 20021207(IM142)"; $Prog = 'imtar'; @@ -33,11 +33,10 @@ use vars qw($Prog $EXPLANATION @OptConfig ## Environments ## -$EXPLANATION = " -$Prog :: compress folder into a single file. -$VERSION +$EXPLANATION = "$VERSION +archiving utility for mail/news messages -usage: $Prog [options] [+folder] [msg(s)] +Usage: $Prog [OPTIONS] [FOLDER] [MSGS] "; @OptConfig =( @@ -77,8 +76,8 @@ exit $EXIT_SUCCESS; ## ## Work horse ## -sub make_mmdf ($$$) { - my ($src, $dst, $msgs) = @_; +sub make_mmdf($$$) { + my($src, $dst, $msgs) = @_; my $msg; my @msg_paths; @@ -95,7 +94,7 @@ sub make_mmdf ($$$) { im_die("cannot open $dst\n"); } } - foreach (@msg_paths){ + foreach (@msg_paths) { $msg = $_; im_notice("source file: \"$msg\"\n"); &open_msg($msg); @@ -104,12 +103,12 @@ sub make_mmdf ($$$) { print STDERR "done\n" unless $opt_noharm; } -sub open_msg ($) { +sub open_msg($) { my $msg = $_; my $mmdf_delimiter="\001\001\001\001"; if (im_open(\*ART, "<$msg")) { print "$mmdf_delimiter\n"; - print while(<ART>); + print while (<ART>); print "$mmdf_delimiter\n"; close(ART); } else { @@ -117,6 +116,65 @@ sub open_msg ($) { } } +__END__ + +=head1 NAME + +imtar - archiving utility for mail/news messages + +=head1 SYNOPSIS + +B<imtar> [OPTIONS] [FOLDER] [MSGS] + +=head1 DESCRIPTION + +The I<imtar> command is an archiving utility for mail/news messages. + +Messages are converted into a single MMDF file ("^A^A^A^A" + MSG ++ "^A^A^A^A", "^A^A^A^A" + MSG + "^A^A^A^A", ...). You can +extract messages by the I<imget> command. + +This command is provided by IM (Internet Message). + +=head1 OPTIONS + +=over 5 + +=item I<-s, --src=FOLDER> + +Set source folder. Default value is "+inbox". +"--src=+xxx" is equivalent to "+xxx". + +=item I<-d, --dst=STRING> + +Destination MMDF file. Default value is "./msgbox". + +=item I<-n, --noharm={on,off}> + +No operation. Show what will happen. + +=item I<-v, --verbose={on,off}> + +Print verbose messages when running. + +=item I<--debug=DEBUG_OPTION> + +Print debug messages when running. + +=item I<-h, --help> + +Display help message and exit. + +=back + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/dist/IM/install-sh b/img/dist/IM/install-sh index ab74c882..e9de2384 100755 --- a/img/dist/IM/install-sh +++ b/img/dist/IM/install-sh @@ -1,15 +1,27 @@ #!/bin/sh # # install - install a program, script, or datafile -# This comes from X11R5. +# This comes from X11R5 (mit/util/scripts/install.sh). +# +# Copyright 1991 by the Massachusetts Institute of Technology +# +# Permission to use, copy, modify, distribute, and sell this software and its +# documentation for any purpose is hereby granted without fee, provided that +# the above copyright notice appear in all copies and that both that +# copyright notice and this permission notice appear in supporting +# documentation, and that the name of M.I.T. not be used in advertising or +# publicity pertaining to distribution of the software without specific, +# written prior permission. M.I.T. makes no representations about the +# suitability of this software for any purpose. It is provided "as is" +# without express or implied warranty. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written -# from scratch. -# +# from scratch. It can only install one file at a time, a restriction +# shared with many OS's install programs. # set DOITPROG to echo to test this script @@ -29,7 +41,7 @@ stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" -tranformbasename="" +transformbasename="" transform_arg="" instcmd="$mvprog" chmodcmd="$chmodprog 0755" @@ -106,6 +118,7 @@ if [ x"$dir_arg" != x ]; then if [ -d $dst ]; then instcmd=: + chmodcmd="" else instcmd=mkdir fi diff --git a/img/lib/IM/Address.pm b/img/lib/IM/Address.pm index ba5129cd..089a8b31 100644 --- a/img/lib/IM/Address.pm +++ b/img/lib/IM/Address.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Address.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Address.pm version 20021207(IM142)"; package IM::Address; require 5.003; @@ -22,36 +22,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(extract_addr replace_addr fetch_addr); -=head1 NAME - -Address - RFC822 style address parser - -=head1 SYNOPSIS - - use IM::Address; - - $pure_address_portion = &extract_addr($address_with_comment); - - $replaced_address = &replace_addr($original_address_with_comment, - $pure_notation_of_old_address, $pure_notation_of_new_address); - - ($first, $rest) = &fetch_addr($address_list, $pure_address_flag); - -=head1 DESCRIPTION - - $a = "Motonori Nakamura <motonori\@econ.kyoto-u.ac.jp>"; - &extract_addr($a) returns "motonori@econ.kyoto-u.ac.jp". - - $a = "Motonori Nakamura <motonori\@econ.kyoto-u.ac.jp>"; - $b = "motonori\@econ.kyoto-u.ac.jp"; - $c = "motonori\@wide.ad.jp"; - &replace_addr($a, $b, $c) returns "Motonori Nakamura <motonori@wide.ad.jp>". - - $a = "kazu, nom, motonori"; - &fetch_addr($a, 0) returns ("kazu", " nom, motonori"). - -=cut - use vars qw($FOR_SMTP); # sub fetch_addr ##### EXTRACT AN ADDRESS FROM AN ADDRESS EXPRESSION ##### @@ -60,7 +30,7 @@ use vars qw($FOR_SMTP); # sub fetch_addr # address: an address in any style # return values: pure address portion (NULL if error) # -sub extract_addr ($) { +sub extract_addr($) { my $addrin = shift; $addrin =~ s/\n\s+//g; @@ -75,8 +45,8 @@ sub extract_addr ($) { # new: # return value: replaced expression # -sub replace_addr ($$$) { - my ($expr, $old, $new) = @_; +sub replace_addr($$$) { + my($expr, $old, $new) = @_; my $qold = quotemeta($old); if ($expr =~ /$qold.*$qold/) { @@ -99,18 +69,18 @@ sub replace_addr ($$$) { # rest: rest of address in the list # friendly: user friendly portion of the first address # -sub fetch_addr ($$) { - my ($addrin, $extract) = @_; - my ($addrout, $pureout, $groupsyntax) = ('', '', ''); - my ($friendly1, $friendly2, $c) = ('', '', ''); - my ($inquote, $incomment, $addrquote) = (0, 0, 0); - my ($gotpure, $groupcolon, $route) = (0, 0, 0); +sub fetch_addr($$) { + my($addrin, $extract) = @_; + my($addrout, $pureout, $groupsyntax) = ('', '', ''); + my($friendly1, $friendly2, $c) = ('', '', ''); + my($inquote, $incomment, $addrquote) = (0, 0, 0); + my($gotpure, $groupcolon, $route) = (0, 0, 0); im_debug("fetch_addr(in): $addrin\n") if (&debug('addr')); $FOR_SMTP = (&progname =~ /imput/i) unless (defined($FOR_SMTP)); $addrin = '' unless (defined($addrin)); $route = 1 if ($addrin =~ /^\@/); while ($addrin ne '') { - if ($addrin =~ /^([^\e"\\()<>:;,]+)(.*)/s) { + if ($addrin =~ /^([^\e"\\()<>:;,]+)(.*)/s) { #" $c = $1; $addrin = $2; } elsif ($addrin =~ /^\e/) { @@ -131,7 +101,7 @@ sub fetch_addr ($$) { last if ($c eq ',' && !$inquote && !$incomment && !$groupcolon && !$route); - $friendly2 .= $c unless($addrquote); + $friendly2 .= $c unless ($addrquote); if ($inquote) { $addrout .= $c; $pureout .= $c unless ($gotpure); @@ -141,7 +111,7 @@ sub fetch_addr ($$) { ($c, $addrin) = unpack('a a*', $addrin); $addrout .= $c; $pureout .= $c unless ($gotpure); - $friendly2 .= $c unless($addrquote); + $friendly2 .= $c unless ($addrquote); } next; } elsif ($incomment) { @@ -154,7 +124,7 @@ sub fetch_addr ($$) { } elsif ($c eq '\\') { ($c, $addrin) = unpack('a a*', $addrin); $friendly1 .= $c; - $friendly2 .= $c unless($addrquote); + $friendly2 .= $c unless ($addrquote); $addrout .= $c unless ($extract); } chop($friendly1) unless ($incomment); @@ -183,17 +153,17 @@ sub fetch_addr ($$) { $addrout .= $c; $pureout .= $c unless ($gotpure); ($c, $addrin) = unpack('a a*', $addrin); - $friendly2 .= $c unless($addrquote); + $friendly2 .= $c unless ($addrquote); } elsif ($c eq ':') { $addrout .= $c; $pureout .= $c unless ($gotpure); - if ($addrin =~ /^([^"\()<>:;,]+)(.*)/s) { + if ($addrin =~ /^([^"\()<>:;,]+)(.*)/s) { #" $c = $1; $addrin = $2; } else { ($c, $addrin) = unpack('a a*', $addrin); } - $friendly2 .= $c unless($addrquote); + $friendly2 .= $c unless ($addrquote); $groupcolon = 1 if ($c ne ':'); } elsif ($c eq ';') { if ($groupcolon) { @@ -234,6 +204,50 @@ sub fetch_addr ($$) { 1; +__END__ + +=head1 NAME + +IM::Address - RFC822 style address parser + +=head1 SYNOPSIS + + use IM::Address; + + $pure_address_portion = &extract_addr($address_with_comment); + + $replaced_address = &replace_addr($original_address_with_comment, + $pure_notation_of_old_address, $pure_notation_of_new_address); + + ($first, $rest) = &fetch_addr($address_list, $pure_address_flag); + +=head1 DESCRIPTION + +The I<IM::Address> module is a parser for RFC822 style address. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + $a = "Motonori Nakamura <motonori\@econ.kyoto-u.ac.jp>"; + &extract_addr($a) returns "motonori@econ.kyoto-u.ac.jp". + + $a = "Motonori Nakamura <motonori\@econ.kyoto-u.ac.jp>"; + $b = "motonori\@econ.kyoto-u.ac.jp"; + $c = "motonori\@wide.ad.jp"; + &replace_addr($a, $b, $c) returns "Motonori Nakamura <motonori@wide.ad.jp>". + + $a = "kazu, nom, motonori"; + &fetch_addr($a, 0) returns ("kazu", " nom, motonori"). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Alias.pm b/img/lib/IM/Alias.pm index 6a67c068..ccd30b77 100644 --- a/img/lib/IM/Alias.pm +++ b/img/lib/IM/Alias.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Alias.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Alias.pm version 20021207(IM142)"; package IM::Alias; require 5.003; @@ -24,38 +24,6 @@ use vars qw(@ISA @EXPORT); @EXPORT = qw(alias_read alias_lookup alias_print hosts_read hosts_completion hosts_lookup hosts_print); -=head1 NAME - -Alias - mail and host alias looking up package - -=head1 SYNOPSIS - - use IM::Alias; - - alias_read(mail_alias_files, addrbook_files); - $result = alias_lookup(user_name); - alias_print(alias); - - hosts_read(hosts_alias_files); - $result = hosts_completion(mail_address); - hosts_print(alias); - -=head1 DESCRIPTION - - alias_read("$HOME/.im/Aliases", "$HOME/.im/Addrbook"); - hosts_read("$HOME/.hostaliases"); - - $result = alias_lookup('u'); - print "$result\n" if ($result); - - $result = hosts_completion('u@h'); - print "$result\n" if ($result); - - alias_print("a") displays mail addresses whose alias is "a". - hosts_print("") displays all host aliases. - -=cut - use vars qw(%MAIL_ALIAS_HASH %MAIL_ALIASES %HOST_ALIASES); ##### READ MAIL ALIAS FILES ##### @@ -64,7 +32,7 @@ use vars qw(%MAIL_ALIAS_HASH %MAIL_ALIASES %HOST_ALIASES); # # return value: none # -sub alias_read (;$$) { +sub alias_read(;$$) { my @olds = split(',', shift || aliases_file()); my @news = split(',', shift || addrbook_file()); my $usenew = 0; @@ -127,7 +95,7 @@ sub alias_read (;$$) { $cont =~ s/^\s*/ /; $line .= $cont; } - my ($name, $val) = split('\s*[:=]\s*', $line, 2); + my($name, $val) = split('\s*[:=]\s*', $line, 2); $MAIL_ALIASES{$name} = $val if $val; } else { #personal info. Skip continuous lines. @@ -149,7 +117,7 @@ sub alias_read (;$$) { # alias: an alias to be looked up # return value: aliased address OR null # -sub alias_lookup ($) { +sub alias_lookup($) { my $alias = shift; return '' if ($alias =~ /[\@%!:]/o); @@ -168,7 +136,7 @@ sub alias_lookup ($) { # alias: an alias to be looked up # return value: none # -sub alias_print (;$) { +sub alias_print(;$) { my $alias = shift; if ($alias) { @@ -190,7 +158,7 @@ sub alias_print (;$) { # # return value: none # -sub hosts_read (;$) { +sub hosts_read(;$) { my @aliases = split(',', shift || '~/.hostaliases'); my $ali; @@ -222,11 +190,11 @@ sub hosts_read (;$) { # cmpl: flag whether complete with get_host_byname() or not; # return value: completed address OR null # -sub hosts_completion ($;$) { - my ($addr, $cmpl) = @_; +sub hosts_completion($;$) { + my($addr, $cmpl) = @_; - if ($addr =~ /^([\w-.]+)@([\w-.]+)$/) { - my ($local, $domain) = ($1, $2); + if ($addr =~ /^([\w.-]+)@([\w.-]+)$/) { + my($local, $domain) = ($1, $2); im_debug("searching $domain by host alias file.\n") if &debug('alias'); my $new = $HOST_ALIASES{$domain}; if ($new) { @@ -236,7 +204,7 @@ sub hosts_completion ($;$) { if ($cmpl) { im_debug("searching $domain with gethostbyname().\n") if (&debug('alias')); - my ($he_name) = gethostbyname($domain); + my($he_name) = gethostbyname($domain); if (length($he_name) > length($domain)) { im_debug("found(gethostbyname): $domain -> $he_name\n") if (&debug('alias')); @@ -253,7 +221,7 @@ sub hosts_completion ($;$) { # alias: an alias to be looked up # return value: aliased hosts OR null # -sub hosts_lookup ($) { +sub hosts_lookup($) { my $alias = shift; my $host = $HOST_ALIASES{$alias}; if ($host) { @@ -269,7 +237,7 @@ sub hosts_lookup ($) { # alias: an alias to be looked up # return value: none # -sub hosts_print (;$) { +sub hosts_print(;$) { my $alias = shift; if ($alias) { @@ -287,6 +255,52 @@ sub hosts_print (;$) { 1; +__END__ + +=head1 NAME + +IM::Alias - mail and host alias looking up package + +=head1 SYNOPSIS + + use IM::Alias; + + alias_read(mail_alias_files, addrbook_files); + $result = alias_lookup(user_name); + alias_print(alias); + + hosts_read(hosts_alias_files); + $result = hosts_completion(mail_address); + hosts_print(alias); + +=head1 DESCRIPTION + +The I<IM::Alias> module handles mail and host aliases. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + alias_read("$HOME/.im/Aliases", "$HOME/.im/Addrbook"); + hosts_read("$HOME/.hostaliases"); + + $result = alias_lookup('u'); + print "$result\n" if ($result); + + $result = hosts_completion('u@h'); + print "$result\n" if ($result); + + alias_print("a") displays mail addresses whose alias is "a". + hosts_print("") displays all host aliases. + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Config.pm.in b/img/lib/IM/Config.pm.in index 56ebbdb3..1fc3b263 100644 --- a/img/lib/IM/Config.pm.in +++ b/img/lib/IM/Config.pm.in @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Config.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Config.pm version 20021207(IM142)"; package IM::Config; require 5.003; @@ -40,8 +40,8 @@ use vars qw(@ISA @EXPORT); mbox_style nntpservers nntphistoryfile nntpauthuser set_nntpauthuser popaccount pophistoryfile imapaccount httpproxy noproxy - usepwagent pwagentport usepwfiles pwfiles - expand_path usetouchfile touchfile namazuv2 + usepwagent pwagentport pwagent_tmp_dir pwagent_tmp_path usepwfiles pwfiles + expand_path usetouchfile touchfile namazuv2 namazu_lock_dir namazu_lock_path pop_timeout imap_timeout nntp_timeout dns_timeout connect_timeout command_timeout rcv_buf_siz db_type file_attr $SSH_PATH); @@ -70,7 +70,7 @@ $IM_DB_TYPE = '@im_db_type@'; $FSYNC_NO = @im_fsync_no@; $SSH_PATH = "@im_path_ssh@"; -sub file_attr () { +sub file_attr() { return @im_file_attr@; } @@ -86,7 +86,7 @@ $HOME_DIR =~ s:\\:/:g; # "\home\user" -> "/home/user" $HOME_DIR =~ s/\/$//; # "/home/" -> "/home" $IM_SYS_DIR = $ENV{'IM_SYS_DIR'} || "$IM_LIBDIR"; -$IM_USER_DIR = expand_home($ENV{'IM_USER_DIR'} || '.im'); +$IM_USER_DIR = &expand_home($ENV{'IM_USER_DIR'} || '.im'); $IM_SYS_PROFILE = "$IM_SYS_DIR/SiteConfig"; $IM_USER_PROFILE = "$IM_USER_DIR/Config"; @@ -107,6 +107,7 @@ BEGIN { 'msgmode;i;;MsgMode' => 'Message file mode when created', 'usecl;b;;UseCL' => 'Use value of Content-Length header for delimitation', 'nosync;b;;NoSync' => 'Do not need fsync(2) on writing file', + 'fsyncnumber;i;;FsyncNumber' => 'System call number of fsync', 'allowcrlf;b;;AllowCRLF' => 'CRLF may be in saved message', 'preservedot;b;;PreserveDot' => 'Not substitute "." with "/"', 'addrbookfile;s;;AddrBookFile' => 'Address book file', @@ -132,6 +133,7 @@ BEGIN { 'noproxy;s;;Noproxy' => 'URL regex not to use Proxy server', 'usepwagent;b;;UsePwAgent' => 'Use password agent', 'pwagentport;i;;PwAgentPort' => 'Port to connect agent with TCP/IP', + 'pwagenttmpdir;s;;PwAgentTmpDir' => 'Temporary directory for impwagent', 'usepwfiles;b;;UsePwFiles' => 'Use password files', 'pwfiles;s;;PwFiles' => 'Password files', 'poptimeout;i;20;PopTimeout' => 'Timeout for POP connection', @@ -144,15 +146,16 @@ BEGIN { 'usetouchfile;b;;UseTouchFile' => 'Use touch file', 'touchfile;s;;TouchFile' => 'Touch file name', 'namazuv2;b;;NamazuV2' => 'Use Namazu Version 2', + 'namazulockdir;s;;NamazuLockDir' => 'Lock directory for immknmz', ); # these vars should be in current package? - my (@vars) = (); - my ($i, $name, $desc, $dflt, $vnam); + my(@vars) = (); + my($i, $name, $desc, $dflt, $vnam); for ($i = 0; $i < $#CfgConfig; $i+=2) { ($name, $desc, $dflt, $vnam) = split(';', $CfgConfig[$i]); if ($vnam) { - push(@vars, '$' . $vnam); + push(@vars, '$' . $vnam); #' } } # print "use vars qw(@vars);\n"; @@ -163,7 +166,7 @@ BEGIN { ## ## -sub read_cfg_selector ($) { +sub read_cfg_selector($) { my $argvref = shift; my $i = 0; my $selector = ''; @@ -180,11 +183,10 @@ sub read_cfg_selector ($) { return $selector; } -sub init_opt ($;$) -{ - my ($optref, $cptref) = @_; - my ($name, $desc, $dflt, $vnam, $optn, $help); - my ($i, $N); +sub init_opt($;$) { + my($optref, $cptref) = @_; + my($name, $desc, $dflt, $vnam, $optn, $help); + my($i, $N); @O_IORD = (); ## option list in order %O_DESC = (); # --help -> s|s@|i|i@|f|f@|F|F@|b|B @@ -228,7 +230,7 @@ sub init_opt ($;$) $i++; $help = $$optref[$i]; $i++; - if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B|d)$/){ + if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B|d)$/) { my $abbr; if ($name =~ ',') { ($name, $abbr) = split(',', $name); @@ -265,7 +267,7 @@ sub init_opt ($;$) $i++; $help = $cptref->[$i]; $i++; - if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B)$/){ + if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B)$/) { $optn = "-$name"; ## no lc() push(@O_IORD, $optn); if ($vnam) { @@ -288,10 +290,10 @@ sub init_opt ($;$) return 1; } -sub read_env ($) { +sub read_env($) { my $envref = shift; - my ($i, $N) = (0, scalar(@$envref)); - my ($name, $desc, $dflt, $var); + my($i, $N) = (0, scalar(@$envref)); + my($name, $desc, $dflt, $var); while ($i < $N) { ($name, $desc, $dflt, $var) = split(';', $envref->[$i]); @@ -304,8 +306,8 @@ sub read_env ($) { } } -sub read_cfg () { - my ($profile, @profiles); +sub read_cfg() { + my($profile, @profiles); my $prev_line = ''; my $case; my $use; @@ -400,10 +402,10 @@ sub read_cfg () { } } -sub read_opt ($) { +sub read_opt($) { my $argref = shift; - my ($ref, $i, $N) = (0, 0, scalar(@$argref)); - my ($name, $val, $desc, $vnam); + my($ref, $i, $N) = (0, 0, scalar(@$argref)); + my($name, $val, $desc, $vnam); # delete options from @ARGV so that main{} can treat # @ARGV as argments. @@ -468,8 +470,8 @@ sub read_opt ($) { } } -sub set_selector ($;$) { - my ($selector, $base) = @_; +sub set_selector($;$) { + my($selector, $base) = @_; my $s; foreach $s (split(',', $selector)) { ### xxx lc @@ -480,11 +482,11 @@ sub set_selector ($;$) { } else { if (!defined($base) or $base eq 'default') { push(@SELECTORS, $s) if !defined($base); - foreach (keys(%{$s})){ + foreach (keys(%{$s})) { ${$_} = $s->{$_}; } } else { - foreach (keys(%{$s})){ + foreach (keys(%{$s})) { $base->{$_} = $s->{$_}; } } @@ -493,11 +495,11 @@ sub set_selector ($;$) { return 0; } -sub used_selectors () { +sub used_selectors() { return join(',', @SELECTORS); } -sub sanity_check () { +sub sanity_check() { unless ($MailDir) { im_die("config files\n" . "Please setup user profile \"$IM_USER_PROFILE\".\n" . @@ -505,14 +507,13 @@ sub sanity_check () { } } -sub help ($) -{ +sub help($) { my $explanation = shift; - my ($name, $spec, $desc, $abbr, $dflt); + my($name, $spec, $desc, $abbr, $dflt); print "${explanation}\nOptions are: \n"; - foreach $name (@O_IORD){ + foreach $name (@O_IORD) { next unless (defined($O_HELP{$name})); $desc = $O_DESC{$name}; @@ -548,7 +549,11 @@ sub help ($) print "\t$name$spec $abbr($dflt)\n"; print "\t\t", $O_HELP{$name}, "\n"; } - print "\n* Note that +xxx is equivalent to $O_FOPT=+xxx\n\n" if $O_FOPT; + + if ($O_FOPT) { + print "\nNote that +xxx is equivalent to $O_FOPT=+xxx.\n"; + } + print "\nReport bugs to <img\@mew.org>.\n"; return 1; } @@ -556,10 +561,9 @@ sub help ($) ## ## -sub set_value_cfg ($$$) -{ - my ($name, $val, $case) = @_; - my ($mnam, $desc, $vnam); +sub set_value_cfg($$$) { + my($name, $val, $case) = @_; + my($mnam, $desc, $vnam); $val =~ s/\${(\w+)}/$ENV{$1}/ge; if ($val =~ /^\$(.*)/) { @@ -595,9 +599,8 @@ sub set_value_cfg ($$$) # set_value is not in safe manner. # see if $desc exists before calling this. -sub set_value ($$$$) -{ - my ($desc, $vnam, $val, $who) = @_; # b, $main::opt_help, yes +sub set_value($$$$) { + my($desc, $vnam, $val, $who) = @_; # b, $main::opt_help, yes # require numeric but not numeric, return undef return undef if ($desc =~ /i/ && $val !~ /\d+/); @@ -607,7 +610,7 @@ sub set_value ($$$$) # -> @xxx = (foo, bar, gaz) my @val = split(',', $val); if ($desc =~ /F/) { # xxx how about f - my ($i, $N) = (0, scalar(@val)); + my($i, $N) = (0, scalar(@val)); while ($i < $N) { $val[$i] = "+$val[$i]" unless $val =~ /(^[+\-=%~\/])|(^[a-zA-Z]:)/; @@ -653,9 +656,8 @@ sub set_value ($$$$) return 1; } -sub set_value_case ($$$$) -{ - my ($desc, $vnam, $val, $case) = @_; # b, $main::opt_help, yes +sub set_value_case($$$$) { + my($desc, $vnam, $val, $case) = @_; # b, $main::opt_help, yes # require numeric but not numeric, return undef return undef if ($desc =~ /i/ && $val !~ /\d+/); @@ -685,62 +687,62 @@ sub set_value_case ($$$$) ### Config vs Default ### -sub current_dir () { +sub current_dir() { return $CURRENT_DIR; } -sub home_dir () { +sub home_dir() { return $HOME_DIR; } -sub conf_dir () { +sub conf_dir() { return $IM_USER_DIR; } -sub mail_dir () { +sub mail_dir() { return $MailDir; } -sub mail_path () { +sub mail_path() { return expand_home(mail_dir()); } -sub news_dir () { +sub news_dir() { return $NewsDir; } -sub news_path () { +sub news_path() { return expand_home(news_dir()); } -sub queue_dir () { +sub queue_dir() { return $QueueDir; } -sub queue_path () { +sub queue_path() { expand_path(queue_dir()); } -sub inbox_folder (;$) { - my ($case) = split(',', shift); ## use the first one only +sub inbox_folder(;$) { + my($case) = split(',', shift); ## use the first one only if (defined($case) && $case ne 'default' && defined($case->{InboxFolder}) && - $case->{InboxFolder} ne ''){ + $case->{InboxFolder} ne '') { return $case->{InboxFolder}; } else { return $InboxFolder; } } -sub draft_folder () { +sub draft_folder() { return $DraftFolder; } -sub trash_folder () { +sub trash_folder() { return $TrashFolder; } -sub config_cases () { +sub config_cases() { my @cases = keys(%CASES); if (scalar(@cases) >= 2) { return join(',', @cases); @@ -749,7 +751,7 @@ sub config_cases () { } } -sub config_case_inbox () { +sub config_case_inbox() { my @cases = keys(%CASES); my @caseinbox = (); if (scalar(@cases) >= 2) { @@ -764,11 +766,11 @@ sub config_case_inbox () { } } -sub preserve_dot () { +sub preserve_dot() { return $PreserveDot; } -sub folder_mode ($) { +sub folder_mode($) { my $setumask = shift; $FolderMode = oct($FolderMode) if ($FolderMode =~ /^0\d/); @@ -777,7 +779,7 @@ sub folder_mode ($) { return $FolderMode; } -sub msg_mode ($) { +sub msg_mode($) { my $setumask = shift; $MsgMode = oct($MsgMode) if ($MsgMode =~ /^0\d/); @@ -786,175 +788,191 @@ sub msg_mode ($) { return $MsgMode; } -sub allowcrlf () { +sub allowcrlf() { return $AllowCRLF; } -sub use_cl () { +sub use_cl() { return $UseCL; } -sub no_sync () { +sub no_sync() { return $NoSync; } -sub fsync_no () { - return $FSYNC_NO; +sub fsync_no() { + return $FsyncNumber || $FSYNC_NO; } -sub addrbook_file () { +sub addrbook_file() { return join(',', map {expand_path($_)} split(',', $AddrBookFile)); } -sub aliases_file () { +sub aliases_file() { return join(',', map {expand_path($_)} split(',', $AliasesFile)); } -sub context_file () { +sub context_file() { return &expand_path($ContextFile); } -sub getchksbr_file () { +sub getchksbr_file() { return &expand_path($GetChkSbrFile); } -sub getsbr_file () { +sub getsbr_file() { return &expand_path($GetSbrFile); } -sub scansbr_file () { +sub scansbr_file() { return &expand_path($ScanSbrFile); } -sub scan_header_pick () { +sub scan_header_pick() { return $ScanHeaderPick; } -sub petname_file () { +sub petname_file() { return &expand_path($PetNameFile); } -sub address () { +sub address() { return $Address; } -sub addresses_regex () { +sub addresses_regex() { return $AddrRegex; } -sub msgdbfile () { +sub msgdbfile() { return &expand_path($MsgDBFile); } -sub msgdbtype () { +sub msgdbtype() { return $MsgDBType; } -sub mbox_style () { +sub mbox_style() { return $MBoxStyle; } -sub nntpservers () { +sub nntpservers() { return $NNTPservers; } -sub nntphistoryfile () { +sub nntphistoryfile() { return &expand_path($NNTPhistory); } -sub nntpauthuser () { +sub nntpauthuser() { return $NNTPauthuser; } sub set_nntpauthuser($) { - $NNTPauthuser = shift; + $NNTPauthuser = shift; } -sub popaccount () { +sub popaccount() { return $POPaccount; } -sub pophistoryfile () { +sub pophistoryfile() { return &expand_path($POPhistory); } -sub imapaccount () { +sub imapaccount() { return $IMAPaccount; } -sub httpproxy () { +sub httpproxy() { return $HTTPproxy; } -sub noproxy () { +sub noproxy() { return $Noproxy; } -sub usepwagent () { +sub usepwagent() { return $UsePwAgent; } -sub pwagentport () { +sub pwagentport() { return $PwAgentPort; } -sub usepwfiles () { +sub pwagent_tmp_dir() { + return $PwAgentTmpDir; +} + +sub pwagent_tmp_path() { + return expand_path(pwagent_tmp_dir()); +} + +sub usepwfiles() { return $UsePwFiles; } -sub pwfiles () { +sub pwfiles() { return $PwFiles; } -sub usetouchfile () { +sub usetouchfile() { return $UseTouchFile; } -sub touchfile () { +sub touchfile() { return $TouchFile; } -sub pop_timeout () { +sub pop_timeout() { return $PopTimeout; } -sub imap_timeout () { +sub imap_timeout() { return $ImapTimeout; } -sub nntp_timeout () { +sub nntp_timeout() { return $NntpTimeout; } -sub dns_timeout () { +sub dns_timeout() { return $DnsTimeout; } -sub connect_timeout () { +sub connect_timeout() { return $ConnectTimeout; } -sub command_timeout () { +sub command_timeout() { return $CommandTimeout; } -sub rcv_buf_siz () { +sub rcv_buf_siz() { return $RcvBufSiz; } -sub db_type () { +sub db_type() { return $IM_DB_TYPE; } -sub namazuv2 () { +sub namazuv2() { return $NamazuV2; } +sub namazu_lock_dir() { + return $NamazuLockDir; +} + +sub namazu_lock_path() { + return expand_path(namazu_lock_dir()); +} + ### ### path expansion ### -sub expand_home ($) { +sub expand_home($) { my $folder = shift; return '' if ($folder eq ''); @@ -970,7 +988,7 @@ sub expand_home ($) { return $folder; } -sub expand_path ($) { +sub expand_path($) { my $folder = shift; $folder =~ s/^\s*(.*?)\s*$/$1/; # SPC may be used in folder names @@ -1054,10 +1072,60 @@ QueueDir=queue # relative to ~/.im/ Imget.Src=local # default source of imget (local mailbox) PopHistory=pophist-{POPSERVERID} # to save last state (relative to ~/.im/) NntpHistory=newshist # to save last state (relative to ~/.im/) +# impwagent +PwAgentTmpDir=pwagtmp # temporary directory (relative to ~/.im/) # namazu -NamazuV2=off # use Namazu version2 (1.9.x or late) +NamazuV2=off # use Namazu version 2 (1.9.x or late) +NamazuLockDir=nmzlock # lock directory (relative to ~/.im/) __END__ +=head1 NAME + +IM::Config - confiugration for IM + +=head1 SYNOPSIS + + use IM::Config; + +Subroutines: +read_cfg_selector +init_opt +read_env read_cfg read_opt +set_selector used_selectors +sanity_check +help +home_dir conf_dir +mail_dir mail_path news_dir news_path queue_dir queue_path +inbox_folder draft_folder trash_folder config_cases config_case_inbox +preserve_dot +folder_mode msg_mode allowcrlf use_cl no_sync fsync_no +addrbook_file aliases_file petname_file +context_file getchksbr_file getsbr_file scansbr_file scan_header_pick +address addresses_regex +msgdbfile msgdbtype +mbox_style +nntpservers nntphistoryfile nntpauthuser set_nntpauthuser +popaccount pophistoryfile imapaccount httpproxy noproxy +usepwagent pwagentport pwagent_tmp_dir pwagent_tmp_path usepwfiles pwfiles +expand_path usetouchfile touchfile namazuv2 namazu_lock_dir namazu_lock_path +pop_timeout imap_timeout nntp_timeout dns_timeout +connect_timeout command_timeout rcv_buf_siz +db_type file_attr + +=head1 DESCRIPTION + +The I<IM::Config> module is for configuration of IM. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/EncDec.pm b/img/lib/IM/EncDec.pm index acc1b9a0..11ac71cb 100644 --- a/img/lib/IM/EncDec.pm +++ b/img/lib/IM/EncDec.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::EncDec.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::EncDec.pm version 20021207(IM142)"; package IM::EncDec; require 5.003; @@ -23,40 +23,6 @@ use vars qw(@ISA @EXPORT); b_encode_string b_decode_string q_encode_string q_decode_string); -=head1 NAME - -EncDec - MIME header encoder/decoder - -=head1 SYNOPSIS - - use IM::EncDec; - - $mime_header_encoded_string = - mime_encode_string(string, iso7bit, iso8bit); - $string = - mime_decode_string(mime_header_encoded_string); - - $B_encoded_string = b_encode_string(string); - $string = b_decode_string(B_encoded_string); - - $Q_encoded_string = q_encode_string(string); - $string = q_decode_string(Q_encoded_string); - -=head1 DESCRIPTION - -MIME header encoder/decoder package. - - $_ = "JAPANESE (Kazuhiko Yamamoto)"; - mime_encode_string($_, 'iso-2022-jp', 'iso-8859-1'); - => =?iso-2022-jp?B?GyRCOzNLXE9CSScbKEI=?= - (Kazuhiko Yamamoto) - - s/\n[\t ]+//g; - print mime_decode_string($_), "\n"; - => "JAPANESE (Kazuhiko Yamamoto)" - -=cut - use vars qw(@D2H $mime_encode_switch $mime_decode_switch @@ -90,7 +56,7 @@ $mime_decode_switch = { ## String Encoder/Decoder ## -sub mime_encode_string ($$$) { +sub mime_encode_string($$$) { my($str, $iso7, $iso8) = (@_); my($point, $len, $nstr, $s) = (0, length($str), '', ''); my($single, $double) = ('', ''); @@ -155,12 +121,12 @@ sub mime_encode_string ($$$) { return $nstr; } -sub mime_decode_string ($) { +sub mime_decode_string($) { my $in = shift; return '' if ($in eq ''); if (!$main::opt_mimedecodequoted) { if ($in =~ /^([^"]*)("[^"]*")([\0-\255]*)$/) { - return mime_decode_string($1) . $2 . mime_decode_string($3); + return &mime_decode_string($1) . $2 . &mime_decode_string($3); } } $in =~ s/\?=\s+=\?/?==?/g; @@ -170,7 +136,7 @@ sub mime_decode_string ($) { } sub mime_decode($$$) { - my ($cs, $bq, $str) = @_; + my($cs, $bq, $str) = @_; my $ret = &{$$mime_decode_switch{uc($3)}}($4); if ($cs =~ /iso-8859-([2-9])/i) { $ret = iso_8859_to_ctext($ret, $1); @@ -194,8 +160,8 @@ sub mime_decode($$$) { return $ret; } -sub iso_8859_to_ctext ($$) { - my ($str, $num) = @_; +sub iso_8859_to_ctext($$) { + my($str, $num) = @_; my @index = ("A", "A", "B", "C", "D", "L", "G", "F", "H", "M"); $str =~ s/([\x80-\xff]+)/\e-$index[$num]$1\e-A/g; return $str; @@ -217,9 +183,9 @@ sub iso_8859_to_ctext ($$) { "\xce", "\xb0", "\xb1", "\xc6", "\xb4", "\xb5", "\xc4", "\xb3", "\xc5", "\xb8", "\xb9", "\xba", "\xbb", "\xbc", "\xbd", "\xbe", "\xbf", "\xcf", "\xc0", "\xc1", "\xc2", "\xc3", "\xb6", "\xb2", - "\xcc", "\xcb", "\xb7", "\xc8", "\xcd", "\xc9", "\xc7", "\xca" ); + "\xcc", "\xcb", "\xb7", "\xc8", "\xcd", "\xc9", "\xc7", "\xca"); -sub koi2iso ($) { +sub koi2iso($) { my $str = shift; $str =~ s/(.)/$koi_iso[ord($1)-128]/ge; return $str; @@ -232,12 +198,12 @@ sub koi8r_to_ctext($) { } sub tis_620_to_ctext($) { - my ($str) = shift; + my($str) = shift; $str =~ s/([\x80-\xff]+)/\e-T$1\e-A/g; return $str; } -sub cn_gb_to_ctext ($) { +sub cn_gb_to_ctext($) { my $str = shift; $str =~ s/([\x80-\xff]+)/"\e\$(A" . remove_msb($1) . "\e(B"/ge; return $str; @@ -251,7 +217,7 @@ sub hz_to_ctext($) { return $str; } -sub euc_jp_to_ctext ($) { +sub euc_jp_to_ctext($) { my $str = shift; $str =~ s/((\x8f[\xa0-\xff][\xa0-\xff])+)/"\e\$(D" . remove_msb(remove_ss($1, "\x8f")) . "\e-A"/ge; @@ -261,25 +227,25 @@ sub euc_jp_to_ctext ($) { return $str; } -sub euc_kr_to_ctext ($) { +sub euc_kr_to_ctext($) { my $str = shift; $str =~ s/([\x80-\xff]+)/"\e\$(C" . remove_msb($1) . "\e(B"/ge; return $str; } -sub remove_msb ($) { +sub remove_msb($) { my $str = shift; $str =~ tr/\x80-\xff/\x00-\x7f/; return $str; } -sub remove_ss ($$) { - my ($str, $si) = @_; +sub remove_ss($$) { + my($str, $si) = @_; $str =~ s/$si//g; return $str; } -sub shift_jis_to_ctext ($) { +sub shift_jis_to_ctext($) { my $str = shift; my $kanji = "[\x81-\x9f\xe0-\xef]."; my $kana = "[\xa0-\xdf]"; @@ -292,7 +258,7 @@ sub shift_jis_to_ctext ($) { sub s2j($) { my $str = shift; - my ($c1, $c2); + my($c1, $c2); my $ret = ""; while ($str) { @@ -311,9 +277,9 @@ sub s2j($) { return $ret; } -sub b157to94 ($) { +sub b157to94($) { my $str = shift; - my ($c1, $c2, $tmp); + my($c1, $c2, $tmp); my $ret = ""; while ($str) { @@ -350,14 +316,14 @@ sub big5_to_ctext($) { ## B Encoder/Decoder ## -sub b_encode_string ($) { +sub b_encode_string($) { my $mod3 = length($_[0]) % 3; local($_); $_ = pack('u', $_[0]); chop; s/(^|\n).//mg; - tr[`!-_][A-Za-z0-9+/]; + tr[`!-_][A-Za-z0-9+/]; #` if ($mod3 == 1) { s/..$/==/; } elsif ($mod3 == 2) { s/.$/=/; } @@ -365,7 +331,7 @@ sub b_encode_string ($) { $_; } -sub b_decode_string ($) { +sub b_decode_string($) { my $s64 = shift; my $len; my $res = ''; @@ -378,7 +344,7 @@ sub b_decode_string ($) { if (/(=+)$/) { $len -= length($1); } - tr[A-Za-z0-9+/=][`!-_A]; + tr[A-Za-z0-9+/=][`!-_A]; #` $res .= sprintf("%c%s\n", $len + 32, $_); } @@ -390,7 +356,7 @@ sub b_decode_string ($) { ## Q Encoder/Decoder ## -sub q_encode_string ($;$) { +sub q_encode_string($;$) { my($line, $struct) = @_; local($_); @@ -404,7 +370,7 @@ sub q_encode_string ($;$) { $_; } -sub q_decode_string ($) { +sub q_decode_string($) { my($qstr) = @_; local($_); @@ -416,6 +382,52 @@ sub q_decode_string ($) { 1; +__END__ + +=head1 NAME + +IM::EncDec - MIME header encoder/decoder + +=head1 SYNOPSIS + + use IM::EncDec; + + $mime_header_encoded_string = + mime_encode_string(string, iso7bit, iso8bit); + $string = + mime_decode_string(mime_header_encoded_string); + + $B_encoded_string = b_encode_string(string); + $string = b_decode_string(B_encoded_string); + + $Q_encoded_string = q_encode_string(string); + $string = q_decode_string(Q_encoded_string); + +=head1 DESCRIPTION + +The I<IM::EncDec> module is encoder/decoder for MIME header. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + $_ = "JAPANESE (Kazuhiko Yamamoto)"; + mime_encode_string($_, 'iso-2022-jp', 'iso-8859-1'); + => =?iso-2022-jp?B?GyRCOzNLXE9CSScbKEI=?= + (Kazuhiko Yamamoto) + + s/\n[\t ]+//g; + print mime_decode_string($_), "\n"; + => "JAPANESE (Kazuhiko Yamamoto)" + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/File.pm b/img/lib/IM/File.pm index 0b6c1583..303ab310 100644 --- a/img/lib/IM/File.pm +++ b/img/lib/IM/File.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Jul 7, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::File.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::File.pm version 20021207(IM142)"; package IM::File; require 5.003; @@ -24,24 +24,18 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(im_rename im_link im_unlink); -## im_rename(path1, path2); -## im_link (path1, path2); -## im_unlink(path1); -## -## paths may be full-path or [+=]folder../../message. - use vars qw($CHECKED $USE_DB); -sub im_rename ($$) { - my ($p1, $p2) = @_; - my ($m1, $m2); - my ($ret); +sub im_rename($$) { + my($p1, $p2) = @_; + my($m1, $m2); + my($ret); ($p1, $m1) = expand_path_and_msg($p1); ($p2, $m2) = expand_path_and_msg($p2); - #my ($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); + #my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); #XXX??? - my ($id); + my($id); if (defined($main::id) || $main::opt_noharm) { $id = $main::id; } else { @@ -52,7 +46,7 @@ sub im_rename ($$) { print "mv $p1 $p2\n"; $ret = 1; } else { - if (!($ret = rename($p1, $p2))){ + if (!($ret = rename($p1, $p2))) { $ret = copy($p1, $p2) && unlink($p1); } history_rename($id, $m1, $m2) @@ -61,15 +55,15 @@ sub im_rename ($$) { return $ret; } -sub im_link ($$) { - my ($p1, $p2) = @_; - my ($m1, $m2); - my ($ret); +sub im_link($$) { + my($p1, $p2) = @_; + my($m1, $m2); + my($ret); ($p1, $m1) = expand_path_and_msg($p1); ($p2, $m2) = expand_path_and_msg($p2); - #my ($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); - my ($id); + #my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); + my($id); if (defined($main::id) || $main::opt_noharm) { $id = $main::id; } else { @@ -80,7 +74,7 @@ sub im_link ($$) { print "ln $p1 $p2\n"; $ret = 1; } else { - if (win95p() || os2p() || wntp() || !($ret = link($p1, $p2))){ + if (win95p() || os2p() || wntp() || !($ret = link($p1, $p2))) { $ret = copy($p1, $p2); } history_link($id, $m1, $m2) @@ -89,15 +83,14 @@ sub im_link ($$) { return $ret; } -sub im_unlink ($) -{ - my ($p1) = @_; - my ($m1, $ret); +sub im_unlink($) { + my($p1) = @_; + my($m1, $ret); ($p1, $m1) = expand_path_and_msg($p1); - # my ($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); - my ($id); + # my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); + my($id); if (defined($main::id) || $main::opt_noharm) { $id = $main::id; } else { @@ -120,14 +113,13 @@ sub im_unlink ($) ## ## Private. ## -sub get_msg_info ($) -{ - my ($p, $m) = expand_path_and_msg(shift); - my ($id, $date, $hdr); +sub get_msg_info($) { + my($p, $m) = expand_path_and_msg(shift); + my($id, $date, $hdr); local $/ = ''; - if (im_open(\*MSG, "<$p")){ - $hdr = <MSG>; close(MSG); + if (im_open(\*MSG, "<$p")) { + $hdr = <MSG>; close(MSG); } else { im_warn("no message id in $m.\n"); return undef; @@ -142,9 +134,9 @@ sub get_msg_info ($) return ($id); } -sub unexpand_path ($) { +sub unexpand_path($) { my $path = shift; - my ($mail_path, $news_path) = (mail_path(), news_path()); + my($mail_path, $news_path) = (mail_path(), news_path()); $path =~ s!^$mail_path/*!\+!; $path =~ s!^$news_path/*!\=!; @@ -152,12 +144,12 @@ sub unexpand_path ($) { return $path; } -sub expand_path_and_msg ($) { +sub expand_path_and_msg($) { my $path_or_msg = shift; return (expand_path($path_or_msg), unexpand_path($path_or_msg)); } -sub USE_DB () { +sub USE_DB() { if (!$CHECKED) { $CHECKED = 1; if ($USE_DB = msgdbfile()) { @@ -172,6 +164,36 @@ sub USE_DB () { 1; +__END__ + +=head1 NAME + +IM::File - mail/news file handler + +=head1 SYNOPSIS + + use IM::File; + + im_rename(path1, path2); + im_link(path1, path2); + im_unlink(path1); + +Paths may be full-path or [+=]folder../../message. + +=head1 DESCRIPTION + +The I<IM::File> module handles mail/news message files. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Folder.pm b/img/lib/IM/Folder.pm index 572e8b8d..6170a4ee 100644 --- a/img/lib/IM/Folder.pm +++ b/img/lib/IM/Folder.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Folder.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Folder.pm version 20021207(IM142)"; package IM::Folder; require 5.003; @@ -26,58 +26,11 @@ use vars qw(@ISA @EXPORT); get_message_paths create_folder touch_folder chk_folder_existance chk_msg_existance get_impath); -=head1 NAME - -Folder - IM folder handler - -=head1 DESCRIPTION - - -=head1 SYNOPSIS - -use IM::Folder; - -$current_folder_name = &cur_folder(); - -&set_cur_folder($new_current_folder_name); - -($number_of_files, - $number_of_message_files, - $minimum_message_number, - $maximum_message_number) = &folder_info($folder_name); - -$message_number = &message_number($message_number_or_name); - -@message_number_array = &message_range($message_range_string); - -$message_file_path = &message_name($folder_name, $message_number); - -=head1 DESCRIPTION - -&cur_folder(); - results "+inbox" - -&set_cur_folder("+inbox"); - -($a, $b, $c, $d) = &folder_info("+inbox"); - results (10, 3, 1, 3) - -&message_number("+inbox", "cur"); - results 3 - -&message_range("+inbox", "1-3"); - results (1, 2, 3) - -&message_name("+inbox", "3"); - results "/usr/home/itojun/Mail/inbox/3" - -=cut - # # Mail folder related routines. # -sub cur_folder () { +sub cur_folder() { my $folder; local(*IN); @@ -95,7 +48,7 @@ sub cur_folder () { return $folder; } -sub set_cur_folder ($) { +sub set_cur_folder($) { my($folder) = @_; local(*IN, *OUT); my($buf); @@ -118,7 +71,7 @@ sub set_cur_folder ($) { close(OUT); } -sub folder_info ($) { +sub folder_info($) { my($folder) = @_; local(*DIR); my(@allfiles, $filecnt, $numfilecnt, $min, $max); @@ -135,8 +88,8 @@ sub folder_info ($) { return ($filecnt, $numfilecnt, $min, $max); } -sub message_list ($) { - my ($folder_dir) = @_; +sub message_list($) { + my($folder_dir) = @_; my @filesinfolder; opendir(DIR, $folder_dir) || im_die("can't open $folder_dir.\n"); @@ -146,9 +99,9 @@ sub message_list ($) { return @filesinfolder; } -sub message_number ($$;@) { - my ($folder, $number, @filesinfolder) = @_; - my ($folder_dir, $offset, $max, $min); +sub message_number($$;@) { + my($folder, $number, @filesinfolder) = @_; + my($folder_dir, $offset, $max, $min); # simple case: digits if ($number !~ /\D/) { @@ -158,7 +111,7 @@ sub message_number ($$;@) { # get folder $folder = cur_folder if ($folder eq ''); $folder_dir = expand_path($folder); - return '' if (!-d $folder_dir); + return '' if (! -d $folder_dir); @filesinfolder = message_list($folder_dir) if (scalar(@_) == 2); @@ -203,8 +156,8 @@ sub message_number ($$;@) { return ''; } -sub message_range ($$@) { - my ($folder, $range, @filesinfolder) = @_; +sub message_range($$@) { + my($folder, $range, @filesinfolder) = @_; my $range_regexp = '\d+|first|last|next|prev'; $folder = cur_folder if ($folder eq ''); @@ -215,7 +168,7 @@ sub message_range ($$@) { } if ($range =~ /^($range_regexp|new)-($range_regexp|new)$/) { - my ($start, $end) = ($1, $2); + my($start, $end) = ($1, $2); $start = message_number($folder, $start, @filesinfolder); $end = message_number($folder, $end, @filesinfolder); @@ -226,7 +179,7 @@ sub message_range ($$@) { return grep($start <= $_ && $_ <= $end, @filesinfolder); } } elsif ($range =~ /^($range_regexp):([+-]?)(\d+)$/) { - my ($start, $dir, $n) = ($1, $2, $3); + my($start, $dir, $n) = ($1, $2, $3); if ($dir eq '') { $dir = ($start eq 'last') ? '-' : '+'; } @@ -247,7 +200,7 @@ sub message_range ($$@) { } } -sub message_name ($$) { +sub message_name($$) { my($folder, $number) = @_; $number = &message_number($folder, $number); @@ -258,9 +211,9 @@ sub message_name ($$) { } } -sub get_message_paths ($@) { - my ($folder, @messages0) = @_; # local @messages0? - my ($i, @messages, @x); # local(@messages, @x);? +sub get_message_paths($@) { + my($folder, @messages0) = @_; # local @messages0? + my($i, @messages, @x); # local(@messages, @x);? my $folder_dir = &expand_path($folder); @@ -272,7 +225,7 @@ sub get_message_paths ($@) { # messages specified. # print the path to the message. - if (!-d $folder_dir) { + if (! -d $folder_dir) { $@ = "no such folder $folder"; return (); } @@ -305,7 +258,7 @@ sub get_message_paths ($@) { grep($_ = "$folder_dir/$_", @messages); } -sub create_folder ($) { +sub create_folder($) { my $folder = shift; my $path = &expand_path($folder); return 0 if (-d $path); @@ -331,9 +284,9 @@ sub create_folder ($) { return 0; } -sub touch_folder ($) { +sub touch_folder($) { if (&usetouchfile()) { - my ($dir) = shift; + my($dir) = shift; $dir =~ s/\/\d+$//; $dir = &expand_path($dir); my($file) = ($dir . "/" . &touchfile()); @@ -341,7 +294,7 @@ sub touch_folder ($) { print OF "touched by IM."; close(OF); } elsif (&os2p) { - my ($dir) = shift; + my($dir) = shift; $dir =~ s/\/\d+$//; $dir = &expand_path($dir); my $now = time; # XXX @@ -352,19 +305,19 @@ sub touch_folder ($) { ## ## Check folder existance. ## -sub chk_folder_existance (@) { +sub chk_folder_existance(@) { my @folders = @_; my $path; im_debug("chk_folder_existance: folder: @folders\n") if (&debug('all')); - foreach (@folders){ + foreach (@folders) { next if /^[%-]/; # skip IMAP and News folders $path = get_impath($_); if (-e $path) { im_die "folder $_ is not writable. (Nothing was refiled.)\n" - if (!-w $path); + if (! -w $path); } else { if (create_folder($path) == 0) { im_warn "created folder $_.\n"; @@ -376,20 +329,21 @@ sub chk_folder_existance (@) { im_debug("chk_folder_existance: OK.\n") if (&debug('all')); } -sub chk_msg_existance ($@) { +sub chk_msg_existance($@) { my $folder = shift; my @paths = get_impath($folder, @_); im_debug("chk_msg_existance: folder: $folder msg: @_\n") if (&debug('all')); - foreach (@paths){ - im_die "message specification error in $folder. (Nothing was refiled.)\n" - if (!-f $_); + foreach (@paths) { + if (! -f $_) { + im_die "message specification error in $folder. (Nothing was refiled.)\n"; + } } im_debug("chk_msg_existance: OK.\n") if (&debug('all'));; } -sub get_impath ($@) { +sub get_impath($@) { my $folder = shift; my @msgs = @_; my @paths; @@ -403,6 +357,64 @@ sub get_impath ($@) { 1; +__END__ + +=head1 NAME + +IM::Folder - mail/news folder handler + +=head1 SYNOPSIS + + use IM::Folder; + + $current_folder_name = &cur_folder(); + + &set_cur_folder($new_current_folder_name); + + ($number_of_files, + $number_of_message_files, + $minimum_message_number, + $maximum_message_number) = &folder_info($folder_name); + + $message_number = &message_number($message_number_or_name); + + @message_number_array = &message_range($message_range_string); + + $message_file_path = &message_name($folder_name, $message_number); + +=head1 DESCRIPTION + +The I<IM::Folder> module handles mail/news message folders. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + &cur_folder(); + results "+inbox" + + &set_cur_folder("+inbox"); + + ($a, $b, $c, $d) = &folder_info("+inbox"); + results (10, 3, 1, 3) + + &message_number("+inbox", "cur"); + results 3 + + &message_range("+inbox", "1-3"); + results (1, 2, 3) + + &message_name("+inbox", "3"); + results "/usr/home/itojun/Mail/inbox/3" + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/GetPass.pm b/img/lib/IM/GetPass.pm index ec252fbf..6c4caf5f 100644 --- a/img/lib/IM/GetPass.pm +++ b/img/lib/IM/GetPass.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 30, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::GetPass.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::GetPass.pm version 20021207(IM142)"; package IM::GetPass; require 5.003; @@ -24,19 +24,7 @@ use vars qw(@ISA @EXPORT); @EXPORT = qw(getpass getpass_interact loadpass savepass connect_agent talk_agent findpass); -=head1 NAME - -GetPass - Get password from tty or ... - -=head1 SYNOPSIS - -($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); - -=head1 DESCRIPTION - -=cut - -sub getpass ($$$$) { +sub getpass($$$$) { my($proto, $auth, $host, $user) = @_; my $pass = ''; my $agtfound = 0; @@ -57,14 +45,14 @@ sub getpass ($$$$) { return ($pass, $agtfound, $interact); } -sub getpass_interact ($) { - my ($prompt) = @_; - my ($secret, $termios, $c_lflag); +sub getpass_interact($) { + my($prompt) = @_; + my($secret, $termios, $c_lflag); if (! -t STDIN) { # stty is not effective for Mule since it's not terminal base. # Anyway, Mew never echos back even if getpass echos back. - } elsif (eval 'require POSIX' & ! win95p() ) { + } elsif (eval 'require POSIX' & !win95p()) { import POSIX qw(termios_h); $termios = new POSIX::Termios; $termios->getattr(fileno(STDIN)); @@ -73,7 +61,7 @@ sub getpass_interact ($) { $termios->setattr(fileno(STDIN), &POSIX::TCSANOW); } elsif (unixp()) { # non-POSIX-ish UNIX. # stty might be available. - my ($OldPath) = $ENV{'PATH'}; # for SUID version + my($OldPath) = $ENV{'PATH'}; # for SUID version $ENV{'PATH'} = '/bin:/usr/bin'; system('/bin/stty -echo'); # Ignore errors. $ENV{'PATH'} = $OldPath; @@ -92,7 +80,7 @@ sub getpass_interact ($) { $termios->setlflag($c_lflag); $termios->setattr(fileno(STDIN), &POSIX::TCSANOW); } elsif (unixp()) { # non-POSIX-ish UNIX. - my ($OldPath) = $ENV{'PATH'}; # for SUID version + my($OldPath) = $ENV{'PATH'}; # for SUID version $ENV{'PATH'} = '/bin:/usr/bin'; system('/bin/stty echo'); # Ignore errors. $ENV{'PATH'} = $OldPath; @@ -101,9 +89,9 @@ sub getpass_interact ($) { return $secret; } -sub loadpass ($$$$) { - my ($proto, $auth, $path, $user) = @_; - local ($_); +sub loadpass($$$$) { + my($proto, $auth, $path, $user) = @_; + local($_); my $key = &connect_agent(0); return '' if ($key eq ''); my @keys = unpack('C*', $key); @@ -124,9 +112,9 @@ sub loadpass ($$$$) { } } -sub savepass ($$$$$) { - my ($proto, $auth, $path, $user, $pass) = @_; - local ($_); +sub savepass($$$$$) { + my($proto, $auth, $path, $user, $pass) = @_; + local($_); my $key = &connect_agent(0); return '' if ($key eq ''); my @keys = unpack('C*', $key); @@ -141,8 +129,8 @@ sub savepass ($$$$$) { &talk_agent("SAVE\t$proto\t$auth\t$path\t$user\nPASS\t$pass\n", 0); } -sub connect_agent ($) { - my ($surpresserror) = shift; +sub connect_agent($) { + my($surpresserror) = shift; require Socket && import Socket; my $realuser = im_getlogin(); @@ -150,7 +138,7 @@ sub connect_agent ($) { im_warn("pwagent: can not get login name\n") unless ($surpresserror); return ''; } - my $dir = "/tmp/im-$realuser"; + my $dir = &pwagent_tmp_path() . "-$realuser"; my $port = &pwagentport(); if ($port > 0) { @@ -172,7 +160,7 @@ sub connect_agent ($) { return ''; } - my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev) = stat($dir); + my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev) = stat($dir); if ($mode & 0077) { im_warn("pwagent: invalid mode: $dir\n") unless ($surpresserror); return ''; @@ -199,8 +187,8 @@ sub connect_agent ($) { return $res; } -sub talk_agent ($) { - my ($msg) = shift; +sub talk_agent($) { + my($msg) = shift; print SOCK $msg; my $res = <SOCK>; shutdown (SOCK, 2); @@ -210,9 +198,9 @@ sub talk_agent ($) { } sub findpass($$$$) { - my ($proto, $auth, $host, $user) = @_; - local ($_); - my ($passfile); + my($proto, $auth, $host, $user) = @_; + local($_); + my($passfile); foreach $passfile (split(',', &pwfiles())) { $passfile = &expand_path($passfile); @@ -222,8 +210,8 @@ sub findpass($$$$) { next if (/^(#.*)?$/); # s/\s+(\#.*)?$//; # remove comments if (/^(\S+)\s+(\S+)\s+(\S+)\s+(\S.+)$/) { - my ($tmp_host, $tmp_user, $tmp_pass) = ($2, $3, $4); - my ($tmp_proto, $tmp_auth) = split('/', $1); + my($tmp_host, $tmp_user, $tmp_pass) = ($2, $3, $4); + my($tmp_proto, $tmp_auth) = split('/', $1); if (($tmp_proto eq $proto) && ($tmp_auth eq $auth) && ($tmp_host eq $host) @@ -241,6 +229,32 @@ sub findpass($$$$) { 1; +__END__ + +=head1 NAME + +IM::GetPass - get password from tty or ... + +=head1 SYNOPSIS + + use IM::GetPass; + + ($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); + +=head1 DESCRIPTION + +The I<IM::GetPass> module handles password for mail/news servers. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Grep.pm b/img/lib/IM/Grep.pm index 32bf0c0f..20cfb878 100644 --- a/img/lib/IM/Grep.pm +++ b/img/lib/IM/Grep.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Nov 03, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Grep.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Grep.pm version 20021207(IM142)"; package IM::Grep; require 5.003; @@ -26,23 +26,6 @@ use vars qw(@ISA @EXPORT %MESSAGE_ID_HASH); @ISA = qw(Exporter); @EXPORT = qw(parse_expression grep_folder sortuniq); -=head1 NAME - -Grep - IM grep folder - -=head1 DESCRIPTION - - -=head1 SYNOPSIS - -use IM::Grep; - -$eval_string = &parse_expression($expression, $casefold); - -@message_number_array = &grep_folder($folder_dir, $eval_string, @ranges); - -=cut - ## ## Environments ## @@ -56,13 +39,13 @@ my $draft_delimiter = "\n----\n"; %MESSAGE_ID_HASH = (); -sub grep_folder ($$$@) { - my ($folder, $eval_string, $dup_check, @ranges) = @_; +sub grep_folder($$$@) { + my($folder, $eval_string, $dup_check, @ranges) = @_; my $folder_dir; my @src_msgs = (); my @messages = (); - if ( $folder =~ /^\-/ ) { + if ($folder =~ /^\-/) { im_warn("Newsspool $folder search not supported (ignored)\n"); } @@ -77,12 +60,12 @@ sub grep_folder ($$$@) { # collect message numbers my @filesinfolder = message_list($folder_dir); - foreach ( @ranges ) { + foreach (@ranges) { my @tmp = (); im_die("illegal range specification: $_\n") unless /^$range_regexp$/; im_debug("extract range $_\n") if &debug('all'); - if (( @tmp = message_range($folder, $_, @filesinfolder )) eq '') { + if ((@tmp = message_range($folder, $_, @filesinfolder)) eq '') { im_warn("message $_ out of range\n"); } push(@src_msgs, @tmp); @@ -181,8 +164,8 @@ sub EOL { 0; } sub LITERAL { 1; } sub SYMBOL { 2; } -sub parse_expression ($$) { - my ($expr, $casefold) = @_; +sub parse_expression($$) { + my($expr, $casefold) = @_; my $case_flag = ''; my $expr_string = ''; @@ -196,8 +179,8 @@ sub parse_expression ($$) { my $SYMBOLS = '[!()=]|\&\&?|\|\|?'; my @tokens = (); - my ($escape, $pos, $len) = (0) x 3; - my ($token, $quote) = ('') x 2; + my($escape, $pos, $len) = (0) x 3; + my($token, $quote) = ('') x 2; my $str; LEX: @@ -272,8 +255,8 @@ sub parse_expression ($$) { # 3: before pattern: LITERAL->1, fallback to 1 # - my ($status, $paren) = (0) x 2; - my ($field, $pattern, $string) = ('') x 3; + my($status, $paren) = (0) x 2; + my($field, $pattern, $string) = ('') x 3; # my $token; PARSE: @@ -372,7 +355,7 @@ sub parse_expression ($$) { } # simple check by perl interpreter - my ($head, $body, $all) = ('') x 3; + my($head, $body, $all) = ('') x 3; eval "$eval_string"; if ($@) { if ($main::opt_quiet) { @@ -389,7 +372,7 @@ sub parse_expression ($$) { } sub parse_die($$$) { - my ($die, $expr, $pos) = @_; + my($die, $expr, $pos) = @_; if (!$main::opt_quiet and !$main::opt_verbose) { im_die("$die in the expression\n"); } @@ -405,12 +388,12 @@ sub parse_die($$$) { ## sort and uniqify a list ## -sub sortuniq (@) { +sub sortuniq(@) { my(@target) = @_; my(%tmp); @tmp{@target} = (undef) x @target; - return ( sort {$a <=> $b} keys %tmp ); + return(sort {$a <=> $b} keys %tmp); } ################################################## @@ -465,6 +448,34 @@ sub make_japanese_pattern { 1; +__END__ + +=head1 NAME + +IM::Grep - grep mail/news folder + +=head1 SYNOPSIS + + use IM::Grep; + + $eval_string = &parse_expression($expression, $casefold); + + @message_number_array = &grep_folder($folder_dir, $eval_string, @ranges); + +=head1 DESCRIPTION + +The I<IM::Grep> module enumerates mail/news messages matched given patterns. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/History.pm b/img/lib/IM/History.pm index dad0eb21..0fd358c2 100644 --- a/img/lib/IM/History.pm +++ b/img/lib/IM/History.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Jul 6, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::History.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::History.pm version 20021207(IM142)"; package IM::History; require 5.003; @@ -42,8 +42,8 @@ sub LookUpMsg { 0 } #sub LookUpDate { 1 } -sub history_open ($) { - my ($with_lock) = @_; +sub history_open($) { + my($with_lock) = @_; $DBtype = msgdbtype(); # package global unless ($DBtype) { $DBtype = db_type(); @@ -74,13 +74,13 @@ sub history_open ($) { im_debug("history database: $dbfile\n") if (&debug('history')); - my ($db, $fd); + my($db, $fd); if ($DBtype eq 'DB') { $db = tie %History, 'DB_File', $dbfile, O_CREAT()|O_RDWR(), &msg_mode(0); } elsif ($DBtype eq 'NDBM') { $db = tie %History, 'NDBM_File', $dbfile, O_CREAT()|O_RDWR(), &msg_mode(0); } elsif ($DBtype eq 'SDBM') { - if (&win95p || &os2p){ + if (&win95p || &os2p) { $db = tie %History, 'SDBM_File', $dbfile, O_CREAT()|O_RDWR()|O_BINARY(), &msg_mode(0); } else { $db = tie %History, 'SDBM_File', $dbfile, O_CREAT()|O_RDWR(), &msg_mode(0); @@ -112,7 +112,7 @@ sub history_open ($) { return -1; } } - if (! &win95p ){ + if (! &win95p) { unless (flock (HIST_FH, LOCK_EX | LOCK_NB)) { im_warn "history: waiting for write lock ($!)\n"; unless (flock (HIST_FH, LOCK_EX)) { @@ -126,12 +126,12 @@ sub history_open ($) { } -sub history_close () { +sub history_close() { if ($nodbfile) { im_err("no database specified.\n"); return; } - if (! &win95p ){ + if (! &win95p) { if ($locked) { flock(HIST_FH, LOCK_UN); } @@ -144,12 +144,12 @@ sub history_close () { } -sub history_lookup ($$) { +sub history_lookup($$) { if ($nodbfile) { im_err("no database specified.\n"); return (); } - my ($msgid, $field) = @_; + my($msgid, $field) = @_; $msgid =~ s/^<(.*)>$/$1/; if (defined($History{$msgid})) { if ($field == LookUpAll) { @@ -167,16 +167,16 @@ sub history_lookup ($$) { } } -sub history_store ($$) { +sub history_store($$) { if ($nodbfile) { im_err("no database specified.\n"); return -1; } - my ($msgid, $folder) = @_; + my($msgid, $folder) = @_; $msgid =~ s/^<(.*)>$/$1/; im_notice("add to history: $msgid\t$folder\n"); if (defined($History{$msgid})) { - my ($ofolder) = split("\t", $History{$msgid}); + my($ofolder) = split("\t", $History{$msgid}); if (scalar(grep($folder eq $_, split(',', $ofolder)))) { return; } @@ -185,17 +185,17 @@ sub history_store ($$) { $History{$msgid} = $folder; } -sub history_delete ($$) { +sub history_delete($$) { if ($nodbfile) { im_err("no database specified.\n"); return -1; } - my ($msgid, $folder) = @_; + my($msgid, $folder) = @_; $msgid =~ s/^<(.*)>$/$1/; if (defined($History{$msgid})) { if ($folder ne '') { - my ($f) = split("\t", $History{$msgid}); - my (@list, $found); + my($f) = split("\t", $History{$msgid}); + my(@list, $found); foreach (split(',', $f)) { if ($_ eq $folder) { $found = 1; @@ -221,25 +221,25 @@ sub history_delete ($$) { } -sub history_dump () { +sub history_dump() { if ($nodbfile) { im_err("no database specified.\n"); return; } - my ($key, $val); + my($key, $val); while (($key, $val) = each(%History)) { print "$key\t$val\n"; } } -sub history_rename ($$$) { +sub history_rename($$$) { if ($nodbfile) {im_err("no database specified.\n"); return;} - my ($id, $m1, $m2) = @_; + my($id, $m1, $m2) = @_; $id =~ s/<(.*)>/$1/; my $h; - if (defined $History{$id}){ + if (defined $History{$id}) { $h = $History{$id}; $h =~ s/^([^\t]+)(.*)//; $h = join(',', grep($_ ne $m1, split(',', $1)), $m2) . $2; @@ -251,14 +251,14 @@ sub history_rename ($$$) { return 0; } -sub history_link ($$$) { +sub history_link($$$) { if ($nodbfile) {im_err("no database specified.\n"); return;} - my ($id, $m1, $m2) = @_; + my($id, $m1, $m2) = @_; $id =~ s/<(.*)>/$1/; my $h; - if (defined $History{$id}){ + if (defined $History{$id}) { $h = $History{$id}; $h =~ s/^([^\t]+)(.*)//; $h = join(',', grep($_ ne $m2, split(',', $1)), $m2) . $2; @@ -270,13 +270,13 @@ sub history_link ($$$) { return 0; } -sub history_unlink ($$) { +sub history_unlink($$) { if ($nodbfile) {im_err("no database specified.\n"); return;} - my ($id, $m1) = @_; + my($id, $m1) = @_; $id =~ s/<(.*)>/$1/; - if (defined $History{$id}){ + if (defined $History{$id}) { my $h = $History{$id}; $h =~ s/^([^\t]+)(.*)//; $h = join(',', grep($_ ne $m1, split(',', $1))) . $2; @@ -293,6 +293,40 @@ sub history_unlink ($$) { 1; +__END__ + +=head1 NAME + +IM::History - mail/news history database handler + +=head1 SYNOPSIS + + use IM::History; + + history_open($with_lock); + history_dump(); + history_store($msgid, $folder); + history_lookup($msgid, LookUpAll); + history_lookup($msgid, LookUpMsg); + history_delete($msgid, $folder); + history_rename($id, $m1, $m2); + history_link($id, $m1, $m2); + history_close(); + +=head1 DESCRIPTION + +The I<IM::History> module handles mail/news database. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Http.pm b/img/lib/IM/Http.pm index 59ff1f8d..34949b61 100644 --- a/img/lib/IM/Http.pm +++ b/img/lib/IM/Http.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Http.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Http.pm version 20021207(IM142)"; package IM::Http; require 5.003; @@ -23,16 +23,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(http_process http_spec); -=head1 NAME - -Http - HTTP handling package - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw(*HTTPd); ######################## @@ -48,10 +38,10 @@ use vars qw(*HTTPd); # 0: success # -1: failure # -sub http_open ($$) { - my ($host, $port) = @_; - my ($resp); - my (@host_list); +sub http_open($$) { + my($host, $port) = @_; + my($resp); + my(@host_list); if ($port ne '' && $port != 0 && $port != 80) { @host_list = ("$host/$port"); } else { @@ -67,16 +57,16 @@ sub http_open ($$) { return 0; } -sub http_close () { +sub http_close() { im_notice("closing HTTP session.\n"); close(HTTPd); return 0; } -sub http_get ($$$) { - my ($path, $user, $pass) = @_; - local ($_); - my (@Message); +sub http_get($$$) { + my($path, $user, $pass) = @_; + local($_); + my(@Message); im_notice("getting $path.\n"); &send_data(\*HTTPd, "GET $path HTTP/1.0", ''); if ($pass ne '') { @@ -94,11 +84,11 @@ sub http_get ($$$) { } # http_process(spec) -sub http_process ($;$$) { - my ($spec, $http_proxy, $no_proxy) = @_; - my ($msg, $rcode, $auth); - my ($user, $host, $port, $path); - my ($target_host, $target_port); +sub http_process($;$$) { + my($spec, $http_proxy, $no_proxy) = @_; + my($msg, $rcode, $auth); + my($user, $host, $port, $path); + my($target_host, $target_port); $http_proxy = '' if ($no_proxy && $spec =~ /$no_proxy/); @@ -190,7 +180,7 @@ sub http_process ($;$$) { } # HTTP (--src=http://[user@]server[:port]/path) -sub http_spec ($) { +sub http_spec($) { my $spec = shift; if ($spec eq '') { @@ -224,6 +214,45 @@ sub http_spec ($) { 1; +__END__ + +=head1 NAME + +IM::Http - HTTP handler + +=head1 SYNOPSIS + + use IM::Http; + + (rc, data) = http_process(spec, http_proxy, no_proxy) + rc: + 0: success + -1: failure + +=head1 DESCRIPTION + +The I<IM::Http> module handles HTTP. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + my($rc, $data) = http_process($spec, httpproxy(), noproxy()) + if ($rc < 0) { + exit 1; + } + foreach (@$data) { + print; + } + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Imap.pm b/img/lib/IM/Imap.pm index 32583f9c..cdd056d6 100644 --- a/img/lib/IM/Imap.pm +++ b/img/lib/IM/Imap.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Imap.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Imap.pm version 20021207(IM142)"; package IM::Imap; require 5.003; @@ -32,16 +32,6 @@ use vars qw(@ISA @EXPORT); imap_put_message imap_put_file imap_refile imap_delete_message ); -=head1 NAME - -Imap - IMAP handling package - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw($ImapSeq); ######################## # IMAP access routines # @@ -52,10 +42,10 @@ use vars qw($ImapSeq); # 0: success # -1: failure # -sub imap_open ($$$$) { - my ($auth, $host, $user, $pass) = @_; - my ($data, $seq, $errmsg); - my (@host_list) = ($host); +sub imap_open($$$$) { + my($auth, $host, $user, $pass) = @_; + my($data, $seq, $errmsg); + my(@host_list) = ($host); my $HANDLE; $pass = '*' unless ($pass); @@ -72,7 +62,7 @@ sub imap_open ($$$$) { } my $failed = 0; if ($auth eq 'LOGIN') { - my ($us, $pw) = ($user, $pass); + my($us, $pw) = ($user, $pass); $us =~ s/([\\"])/\\$1/g; # escape specials $us = "\"$us\""; # quote it $pw =~ s/([\\"])/\\$1/g; # escape specials @@ -134,9 +124,9 @@ sub imap_open ($$$$) { return (0, $HANDLE); } -sub imap_close ($) { - my ($HANDLE) = @_; - my ($seq) = $ImapSeq++; +sub imap_close($) { + my($HANDLE) = @_; + my($seq) = $ImapSeq++; my $failed = 0; if (1) { im_notice("closing IMAP session.\n"); @@ -162,10 +152,10 @@ sub imap_close ($) { return 0; } -sub imap_select ($$$) { - my ($HANDLE, $mbox, $select) = @_; - my ($seq) = $ImapSeq++; - my ($resp, @field); +sub imap_select($$$) { + my($HANDLE, $mbox, $select) = @_; + my($seq) = $ImapSeq++; + my($resp, @field); if ($select) { im_notice("select mbox $mbox and getting number of message.\n"); $resp = &send_command($HANDLE, "im$seq SELECT $mbox", ''); @@ -195,10 +185,10 @@ sub imap_select ($$$) { return $msgs; } -sub imap_get ($$) { - my ($HANDLE, $num) = @_; - my ($seq) = $ImapSeq++; - my (@message); +sub imap_get($$) { + my($HANDLE, $num) = @_; + my($seq) = $ImapSeq++; + my(@message); im_notice("getting message $num.\n"); my $resp = &send_command($HANDLE, "im$seq UID FETCH $num RFC822", ''); my $failed = 0; @@ -236,18 +226,18 @@ sub imap_get ($$) { return (0, \@message); } -sub imap_head ($$) { - my ($HANDLE, $num) = @_; - my ($seq) = $ImapSeq++; +sub imap_head($$) { + my($HANDLE, $num) = @_; + my($seq) = $ImapSeq++; im_notice("getting header of message $num.\n"); my $resp = &send_command($HANDLE, "im$seq UID FETCH $num (RFC822.SIZE RFC822.HEADER)", ''); my $failed = 0; - my (%head); + my(%head); undef %head; if ($resp =~ /^\* \d+ FETCH \((UID $num )?RFC822.SIZE (\d+) RFC822.HEADER \{(\d+)\}/i) { - my ($size, $len) = ($2, $3); + my($size, $len) = ($2, $3); my $field = ''; alarm(imap_timeout()) unless win95p(); $! = 0; @@ -295,8 +285,8 @@ sub imap_head ($$) { return (0, \%head); } -sub imap_from ($$) { - my ($HANDLE, $num) = @_; +sub imap_from($$) { + my($HANDLE, $num) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("getting sender information of message $num.\n"); @@ -349,10 +339,10 @@ sub imap_from ($$) { return 0; } -sub imap_flags ($$) { - my ($HANDLE, $num) = @_; +sub imap_flags($$) { + my($HANDLE, $num) = @_; my $seq = $ImapSeq++; - my ($flags); + my($flags); im_notice("getting flags for $num.\n"); my $failed = 0; my $resp = &send_command($HANDLE, "im$seq UID FETCH $num FLAGS", ''); @@ -370,8 +360,8 @@ sub imap_flags ($$) { return $flags; } -sub imap_delete ($$) { - my ($HANDLE, $num) = @_; +sub imap_delete($$) { + my($HANDLE, $num) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("deleting message $num.\n"); @@ -386,13 +376,13 @@ sub imap_delete ($$) { return 0; } -sub imap_list_folder ($) { - my ($HANDLE) = @_; +sub imap_list_folder($) { + my($HANDLE) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("listing folders.\n"); my $resp = &send_command($HANDLE, "im$seq LIST \"\" *", ''); - my (@folders) = (); + my(@folders) = (); while ($resp !~ /^im$seq/) { $failed = 1 if ($resp =~ /^\* NO/i); if ($resp =~ /^\* LIST \(([^)]*)\) (\S+) (\S+)/) { @@ -407,8 +397,8 @@ sub imap_list_folder ($) { return @folders; } -sub imap_create_folder ($$) { - my ($HANDLE, $folder) = @_; +sub imap_create_folder($$) { + my($HANDLE, $folder) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("creating folder $folder.\n"); @@ -422,8 +412,8 @@ sub imap_create_folder ($$) { return 0; } -sub imap_delete_folder ($$) { - my ($HANDLE, $folder) = @_; +sub imap_delete_folder($$) { + my($HANDLE, $folder) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("deleting folder $folder.\n"); @@ -437,8 +427,8 @@ sub imap_delete_folder ($$) { return 0; } -sub imap_rename_folder ($$$) { - my ($HANDLE, $old, $new) = @_; +sub imap_rename_folder($$$) { + my($HANDLE, $old, $new) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("rename folder from $old to $new.\n"); @@ -452,8 +442,8 @@ sub imap_rename_folder ($$$) { return 0; } -sub imap_copy ($$$$) { - my ($HANDLE, $srcmsg, $dstfolder, $moveflag) = @_; +sub imap_copy($$$$) { + my($HANDLE, $srcmsg, $dstfolder, $moveflag) = @_; im_notice("copying message $srcmsg to $dstfolder.\n"); # my $resp = &imap_select($HANDLE, $dstfolder, 0); # if ($resp < 0) { @@ -480,8 +470,8 @@ sub imap_copy ($$$$) { return 0; } -sub imap_put ($$$) { - my ($HANDLE, $folder, $Msg) = @_; +sub imap_put($$$) { + my($HANDLE, $folder, $Msg) = @_; my $seq = $ImapSeq++; my $failed = 0; im_notice("appending a new message to $folder.\n"); @@ -516,9 +506,9 @@ sub imap_put ($$$) { } # imap_process(handle, how, host, src, dst, limit) -sub imap_process ($$$$$$$) { - my ($HANDLE, $how, $host, $src, $dst, $limit, $noscan) = @_; - my ($msgs, $count) = (0, 0); +sub imap_process($$$$$$$) { + my($HANDLE, $how, $host, $src, $dst, $limit, $noscan) = @_; + my($msgs, $count) = (0, 0); if (($msgs = &imap_select($HANDLE, $src, 1)) < 0) { im_warn("selecting folder $src failed.\n"); return -1; @@ -553,7 +543,7 @@ sub imap_process ($$$$$$$) { im_info("$count message(s).\n"); return $count; } - my ($rc, $message) = &imap_get($HANDLE, $i); + my($rc, $message) = &imap_get($HANDLE, $i); return -1 if ($rc < 0); return -1 if (store_message($message, $dst, $noscan) < 0); &exec_getsbrfile($dst); @@ -573,17 +563,17 @@ sub imap_process ($$$$$$$) { return $msgs; } -sub imap_get_msg ($$$$$) { - my ($src, $dst, $how, $limit, $noscan) = @_; +sub imap_get_msg($$$$$) { + my($src, $dst, $how, $limit, $noscan) = @_; $src =~ s/^imap//i; - my ($folder, $auth, $user, $host) = &imap_spec($src); + my($folder, $auth, $user, $host) = &imap_spec($src); return -1 if ($folder eq ''); - my ($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); + my($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); im_notice("accessing IMAP/$auth:$user\@$host for $how\n"); - my ($rc, $HANDLE) = &imap_open($auth, $host, $user, $pass); + my($rc, $HANDLE) = &imap_open($auth, $host, $user, $pass); if ($rc == 0) { &savepass('imap', $auth, $host, $user, $pass) if ($pass ne '' && $interact && &usepwagent()); @@ -601,7 +591,7 @@ sub imap_get_msg ($$$$$) { } # IMAP folder (--src=imap[%folder][//auth][:user][@server[/port]]) -sub imap_spec ($) { +sub imap_spec($) { my $spec = shift; if ($spec eq '' || $spec !~ /[:\@]|\/\//) { @@ -619,7 +609,7 @@ sub imap_spec ($) { $spec .= $s if ($s ne ''); } - my ($folder, $auth, $host) = ('INBOX', 'auth', 'localhost'); + my($folder, $auth, $host) = ('INBOX', 'auth', 'localhost'); my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || im_getlogin(); if ($spec =~ /^%(.*)\/(\/.*)/) { @@ -658,13 +648,13 @@ sub imap_spec ($) { return ($folder, $auth, $user, $host); } -sub imap_range2set ($@) { - my ($HANDLE, @ranges) = @_; - my (@uids, $fromuid, $dir); +sub imap_range2set($@) { + my($HANDLE, @ranges) = @_; + my(@uids, $fromuid, $dir); my @alluids = &imap_all_uids($HANDLE); return -1 if ($alluids[0] < 0); - my ($min, $max) = ($alluids[0], $alluids[$#alluids]); + my($min, $max) = ($alluids[0], $alluids[$#alluids]); @ranges = ('first-last') if ($#ranges < 0 || grep(/^all$/, @ranges)); local $_; @@ -703,9 +693,9 @@ sub imap_range2set ($@) { return join(',', grep($_, @ranges)); } -sub imap_range2msgs ($@) { - my ($HANDLE, @ranges) = @_; - my ($seq, $set, $resp, @uids); +sub imap_range2msgs($@) { + my($HANDLE, @ranges) = @_; + my($seq, $set, $resp, @uids); $set = &imap_range2set($HANDLE, @ranges); $seq = $ImapSeq++; @@ -721,9 +711,9 @@ sub imap_range2msgs ($@) { return wantarray ? @uids : $uids[0]; } -sub imap_folder_regname ($) { +sub imap_folder_regname($) { my $folder = shift; # %... - my ($auth, $user, $host); + my($auth, $user, $host); ($folder, $auth, $user, $host) = imap_spec($folder); $folder =~ s/^/%/; @@ -731,7 +721,7 @@ sub imap_folder_regname ($) { return "$folder//$auth:$user\@$host"; # may be appended '/port' } -sub imap_folder_name ($) { +sub imap_folder_name($) { my $folder = shift; if ($folder =~ /^%([^:\@]+)/) { @@ -744,9 +734,9 @@ sub imap_folder_name ($) { return ''; } -sub imap_folder_acct ($) { +sub imap_folder_acct($) { my $folder = shift; # %... - my ($auth, $user, $host); + my($auth, $user, $host); ($folder, $auth, $user, $host) = imap_spec($folder); @@ -756,9 +746,9 @@ sub imap_folder_acct ($) { return ''; } -sub imap_all_uids ($) { - my ($HANDLE) = @_; - my ($seq, $resp, @uids); +sub imap_all_uids($) { + my($HANDLE) = @_; + my($seq, $resp, @uids); $seq = $ImapSeq++; $resp = &send_command($HANDLE, "im$seq UID SEARCH 1:*", ''); @@ -773,8 +763,8 @@ sub imap_all_uids ($) { return @uids; } -sub imap_message_number ($$$) { - my ($min, $max, $num) = @_; +sub imap_message_number($$$) { + my($min, $max, $num) = @_; return $num if $num =~ /^\d+$/; return $min if $num =~ /^first$/; @@ -787,9 +777,9 @@ sub imap_message_number ($$$) { ## For imls ## -sub imap_scan_folder ($$@) { - my ($HANDLE, $folder, @ranges) = @_; - my ($uid, $size, $len); +sub imap_scan_folder($$@) { + my($HANDLE, $folder, @ranges) = @_; + my($uid, $size, $len); my $msgset = &imap_range2set($HANDLE, @ranges); return 0 if !$msgset; @@ -857,20 +847,20 @@ sub imap_scan_folder ($$@) { my %ImapHandleCache = (); -sub imap_open_folders ($@) { - my ($create, @folders) = @_; +sub imap_open_folders($@) { + my($create, @folders) = @_; foreach (@folders) { next unless (/^%/); my $acct = imap_folder_acct($_); my $ifld = imap_folder_name($_); - my ($rc, $HANDLE); + my($rc, $HANDLE); unless ($HANDLE = $ImapHandleCache{$acct}) { - my ($dummy, $auth, $user, $host) + my($dummy, $auth, $user, $host) = imap_spec(imap_folder_regname($_)); - my ($pass, $agtfound, $interact) = + my($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); ($rc, $HANDLE) = imap_open($auth, $host, $user, $pass); @@ -898,19 +888,19 @@ sub imap_open_folders ($@) { return 0; } -sub imap_close_folders () { +sub imap_close_folders() { foreach (keys(%ImapHandleCache)) { imap_close($ImapHandleCache{$_}); } %ImapHandleCache = (); } -sub imap_get_handle ($) { +sub imap_get_handle($) { return $ImapHandleCache{imap_folder_acct(shift)}; } -sub imap_get_message ($$) { - my ($src, $range) = @_; +sub imap_get_message($$) { + my($src, $range) = @_; my $HANDLE = imap_get_handle($src); my $msg = imap_range2msgs($HANDLE, ($range)); @@ -919,7 +909,7 @@ sub imap_get_message ($$) { return (); } - my ($rc, $msgref) = imap_get($HANDLE, $msg); + my($rc, $msgref) = imap_get($HANDLE, $msg); if ($rc < 0) { im_warn("can't get msg $_ from source folder.\n"); return (); @@ -927,8 +917,8 @@ sub imap_get_message ($$) { return $msgref; } -sub imap_put_message ($$;$) { - my ($Message, $dsts, $src_path) = @_; +sub imap_put_message($$;$) { + my($Message, $dsts, $src_path) = @_; my $dst; foreach $dst (@$dsts) { @@ -941,10 +931,10 @@ sub imap_put_message ($$;$) { return 0; } -sub imap_put_file ($$$) { - my ($src, $dsts, $src_path) = @_; +sub imap_put_file($$$) { + my($src, $dsts, $src_path) = @_; my @Message; - local (*SRC); + local(*SRC); unless (im_open(\*SRC, "<$src_path")) { im_warn("can't open local message $src_path.\n"); @@ -959,9 +949,9 @@ sub imap_put_file ($$$) { return imap_put_message(\@Message, $dsts, $src_path); } -sub imap_refile ($$$) { - my ($src, $dsts, $msgs) = @_; - my ($HANDLE, $srcacct, $srcset); +sub imap_refile($$$) { + my($src, $dsts, $msgs) = @_; + my($HANDLE, $srcacct, $srcset); my $link_1st; $srcacct = imap_folder_acct($src); @@ -993,8 +983,8 @@ sub imap_refile ($$$) { return 0; } -sub imap_delete_message () { - my ($src, @range) = @_; +sub imap_delete_message() { + my($src, @range) = @_; my $HANDLE = imap_get_handle($src); my $srcset = imap_range2set($HANDLE, @range); @@ -1003,6 +993,49 @@ sub imap_delete_message () { 1; +__END__ + +=head1 NAME + +IM::Imap - IMAP handler + +=head1 SYNOPSIS + + use IM::Imap; + + imap_open(auth, host, user, pass) + return value: + 0: success + -1: failure + +Other subroutines: +imap_select imap_head imap_get imap_put imap_delete +imap_get_msg imap_spec imap_range2set imap_folder_regname imap_scan_folder +imap_open_folders imap_close_folders imap_get_handle imap_get_message +imap_put_message imap_put_file imap_refile imap_delete_message + +=head1 DESCRIPTION + +The I<IM::Imap> module handles IMAP. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + my($rc, $HANDLE) = imap_open($auth, $host, $user, $pass); + if ($rc < 0) { + exit 1; + } + imap_close($HANDLE); + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Iso2022jp.pm b/img/lib/IM/Iso2022jp.pm index 98f5959b..bcb37bfb 100644 --- a/img/lib/IM/Iso2022jp.pm +++ b/img/lib/IM/Iso2022jp.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Iso2022jp.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Iso2022jp.pm version 20021207(IM142)"; package IM::Iso2022jp; require 5.003; @@ -28,24 +28,6 @@ use vars qw(@ISA @EXPORT); header_iso2022jp_conv ); -=head1 NAME - -Iso2022jp - MIME header encoder for ISO-2022-JP character set - -=head1 SYNOPSIS - -use IM/Iso2022jp; - -$encoded_string_for_structured_header = struct_iso2022jp_mimefy(string); - -$encoded_string_for_unstructured_header = line_iso2022jp_mimefy(string); - -$rcode = header_iso2022jp_conv(\@Header, code_conv_flag); - -=head1 DESCRIPTION - -=cut - use vars qw($Jp_Bin $Jp_Qin $Jp_out $Jis_kanji $Jis_roman $C_pascii); @@ -64,16 +46,16 @@ BEGIN { # return value: (lines, err) # lines: converted lines (NULL if error) # -sub struct_iso2022jp_mimefy ($) { +sub struct_iso2022jp_mimefy($) { my $line_in = shift; - my ($c, $groupsyntax); - my ($inquote, $incomment, $addrquote) = (0, 0, 0); - my ($groupcolon, $need_space, $need_encode) = (0, 0, 0); - my ($line_out, $line_work) = ('', ''); - my ($n); + my($c, $groupsyntax); + my($inquote, $incomment, $addrquote) = (0, 0, 0); + my($groupcolon, $need_space, $need_encode) = (0, 0, 0); + my($line_out, $line_work) = ('', ''); + my($n); im_debug("encoding structured: $line_in\n") if (&debug('encode')); while ($line_in ne '') { - if ($line_in =~ /^($Jis_kanji[^\e]+$Jis_roman([ \t]*$Jis_kanji[^\e]+$Jis_roman)*)(.*)/os){ + if ($line_in =~ /^($Jis_kanji[^\e]+$Jis_roman([ \t]*$Jis_kanji[^\e]+$Jis_roman)*)(.*)/os) { $c = $1; $line_in = $3; $need_encode = 1; @@ -238,7 +220,7 @@ sub struct_iso2022jp_mimefy ($) { # &error_exit; return ''; } - if ($line_out =~ /$Jis_kanji[^\e]+$Jis_roman/o){ + if ($line_out =~ /$Jis_kanji[^\e]+$Jis_roman/o) { im_err("invalid iso-2022-jp charset location in structured field: " . "$line_out\n"); # &error_exit; @@ -253,9 +235,9 @@ sub struct_iso2022jp_mimefy ($) { # lines: continuous header lines to be converted # return value: converted lines # -sub line_iso2022jp_mimefy ($) { - my ($line_in) = @_; - my ($line_out, $this_word, $this_space, $this_code, $follow, $n); +sub line_iso2022jp_mimefy($) { + my($line_in) = @_; + my($line_out, $this_word, $this_space, $this_code, $follow, $n); $follow = 0; $this_space = ''; $line_out = ''; @@ -292,7 +274,7 @@ sub line_iso2022jp_mimefy ($) { $line_in = $3; $this_word .= $1; $this_code = 'iso-2022-jp'; - } elsif ($line_in =~ /^($Jis_roman)(.*)/os){ # XXX + } elsif ($line_in =~ /^($Jis_roman)(.*)/os) { # XXX last if ($this_code ne 'us-ascii' && $this_code ne 'iso-2022-jp'); $line_in = $2; @@ -343,10 +325,10 @@ sub line_iso2022jp_mimefy ($) { # struct: true if in structured field # return value: encoded words # -sub word_iso2022jp_mimefy ($$$$) { - my ($size, $word_in, $need_pre_space, $struct) = @_; - my ($word_out) = ''; - my ($word_conv, $n, $word_sub, $word_rest); +sub word_iso2022jp_mimefy($$$$) { + my($size, $word_in, $need_pre_space, $struct) = @_; + my($word_out) = ''; + my($word_conv, $n, $word_sub, $word_rest); if ($main::NoFolding) { if ($main::HdrQEncoding) { @@ -447,10 +429,10 @@ sub word_iso2022jp_mimefy ($$$$) { # 0: success # -1: failure # -sub header_iso2022jp_conv ($$) { - my ($header, $code_conv) = @_; - my ($i, $c); - my ($field_name, $field_value); +sub header_iso2022jp_conv($$) { + my($header, $code_conv) = @_; + my($i, $c); + my($field_name, $field_value); for ($i = 0; $i <= $#$header; $i++) { im_debug("Iso2022jp: converting: $$header[$i]\n") if (&debug('encode')); $c = &code_check($$header[$i]); @@ -501,8 +483,8 @@ sub header_iso2022jp_conv ($$) { # space: separatig space # return value: a concatinated header string # -sub hdr_cat ($$$) { - my ($str1, $str2, $space) = @_; +sub hdr_cat($$$) { + my($str1, $str2, $space) = @_; if ($str1 eq '' || $str1 =~ /\n[\t ]+$/) { return "$str1$space$str2"; @@ -521,6 +503,34 @@ sub hdr_cat ($$$) { 1; +__END__ + +=head1 NAME + +IM::Iso2022jp - MIME header encoder for ISO-2022-JP + +=head1 SYNOPSIS + + use IM::Iso2022jp; + + $encoded_string_for_structured_header = struct_iso2022jp_mimefy(string); + $encoded_string_for_unstructured_header = line_iso2022jp_mimefy(string); + $rcode = header_iso2022jp_conv(\@Header, code_conv_flag); + +=head1 DESCRIPTION + +The I<IM::Iso2022jp> module is MIME header encoder for ISO-2022-JP. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Japanese.pm b/img/lib/IM/Japanese.pm index 08948d60..f0e1e1bb 100644 --- a/img/lib/IM/Japanese.pm +++ b/img/lib/IM/Japanese.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Japanese.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Japanese.pm version 20021207(IM142)"; package IM::Japanese; require 5.003; @@ -23,22 +23,6 @@ use vars qw(@ISA @EXPORT); convert_iso2022jp_body conv_iso2022jp conv_euc_from_jis conv_euc_from_sjis); -=head1 NAME - -Japanese - IM Japanese handler - -=head1 SYNOPSIS - - use IM::Japanese; - $code = code_check($line, $use_hankaku_kana); - $code = code_check_body($content); - convert_iso2022jp_body($content, $code); - $converted = conv_iso2022jp($line, $code); - -=head1 DESCRIPTION - -=cut - use vars qw($C_jis $C_jis_roman $C_sjis $C_sjis_kana $C_euc $C_euc_kana $C_SorE $C_ascii $C_pascii $C_tascii $C_sascii $C_8bit @@ -75,9 +59,9 @@ BEGIN { # sjis # sORe # -sub code_check ($;$) { - my ($line, $no_hankaku_kana) = @_; - my ($sjis, $euc); +sub code_check($;$) { + my($line, $no_hankaku_kana) = @_; + my($sjis, $euc); if ($line =~ /^$C_ascii*$/o) { return 'ascii'; @@ -114,9 +98,9 @@ sub code_check ($;$) { # EUC # SJIS # -sub code_check_body ($) { +sub code_check_body($) { my $content = shift; - my (%count) = (); + my(%count) = (); $count{'ascii'} = 0; # for debug print $count{'8bit'} = 0; @@ -171,8 +155,8 @@ sub code_check_body ($) { # code: input kanji code # return value: none # -sub convert_iso2022jp_body ($$) { - my ($content, $code) = @_; +sub convert_iso2022jp_body($$) { + my($content, $code) = @_; my $i; for ($i = 0; $i <= $#$content; $i++) { @@ -187,8 +171,8 @@ sub convert_iso2022jp_body ($$) { # code: input kanji code # return value: converted line # -sub conv_iso2022jp ($;$) { - my ($line, $code) = @_; +sub conv_iso2022jp($;$) { + my($line, $code) = @_; im_debug("conv_iso2022jp: $line\n") if (&debug('japanese')); @@ -221,19 +205,19 @@ sub conv_iso2022jp ($;$) { # line: a line of string to be converted # return value: converted line # -sub conv_from_sjis ($) { +sub conv_from_sjis($) { my $line = shift; $line =~ s/((?:$C_sjis|$C_sjis_kana)+)/sjis2jis($1)/geo; return $line; } -sub sjis2jis ($) { +sub sjis2jis($) { my $line = shift; $line =~ s/((?:$C_sjis)+|(?:$C_sjis_kana)+)/s2j($1)/geo; return "$line$E_asc"; } -sub s2e ($) { +sub s2e($) { my $code = shift; - my ($c1, $c2) = unpack('CC', $code); + my($c1, $c2) = unpack('CC', $code); if (0xa1 <= $c1 && $c1 <= 0xdf) { $c2 = $c1; $c1 = 0x8e; @@ -246,7 +230,7 @@ sub s2e ($) { } return pack('CC', $c1, $c2); } -sub s2j ($) { +sub s2j($) { my $cur = shift; if ($cur =~ /^$C_sjis_kana/o) { $cur =~ tr/\xa1-\xdf/\x21-\x5f/; @@ -264,17 +248,17 @@ sub s2j ($) { # line: a line of string to be converted # return value: converted line # -sub conv_from_euc ($) { +sub conv_from_euc($) { my $line = shift; $line =~ s/((?:$C_euc|$C_euc_kana)+)/euc2jis($1)/geo; return $line; } -sub euc2jis ($) { +sub euc2jis($) { my $line = shift; $line =~ s/((?:$C_euc)+|(?:$C_euc_kana)+)/e2j($1)/geo; return "$line$E_asc"; } -sub e2j ($) { +sub e2j($) { my $cur = shift; $cur =~ tr/\xa1-\xfe/\x21-\x7e/; if ($cur =~ tr/\x8e//d) { @@ -291,7 +275,7 @@ sub e2j ($) { # return value: converted line # -sub conv_euc_from_sjis ($) { +sub conv_euc_from_sjis($) { my $line = shift; $line =~ s/($C_sjis|$C_sjis_kana)/s2e($1)/geo; return $line; @@ -304,14 +288,14 @@ sub conv_euc_from_sjis ($) { # return value: converted line # -sub conv_euc_from_jis ($) { +sub conv_euc_from_jis($) { my $line = shift; $line =~ s/$C_jis/j2e($1,$2)/geo; $line =~ s/\e\$C_jis_roman/$2/geo; return $line; } -sub j2e ($$) { +sub j2e($$) { my $esc = shift; my $line = shift; if ($esc =~ /\e\$[\@B]/) { @@ -322,6 +306,36 @@ sub j2e ($$) { 1; +__END__ + +=head1 NAME + +IM::Japanese - Japanese message handler + +=head1 SYNOPSIS + + use IM::Japanese; + + $code = code_check($line, $use_hankaku_kana); + $code = code_check_body($content); + convert_iso2022jp_body($content, $code); + $converted = conv_iso2022jp($line, $code); + +=head1 DESCRIPTION + +The I<IM::Japanese> module handles Japanese message encoded with +ISO-2022-JP, EUC-JP, Shift_JIS, or US-ASCII. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/LocalMbox.pm b/img/lib/IM/LocalMbox.pm index 8a38fde1..1c27bbee 100644 --- a/img/lib/IM/LocalMbox.pm +++ b/img/lib/IM/LocalMbox.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::LocalMbox.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::LocalMbox.pm version 20021207(IM142)"; package IM::LocalMbox; require 5.003; @@ -25,22 +25,6 @@ use vars qw(@ISA @EXPORT $getchk_hook); @ISA = qw(Exporter); @EXPORT = qw(local_get_msg); -=head1 NAME - -LocalMbox - local mailbox managing package - -=head1 SYNOPSIS - -$num_msgs = &local_get_msg(source_mailbox, destination_folder, access_mode); - -=head1 DESCRIPTION - -$mbox = 'local:/var/mail/motonori'; -$folder = '+inbox' -$num_msgs = &local_get_msg($mbox, $folder, 'get'); - -=cut - use vars qw($locked_by_file $locked_by_flock); ################################# # local mailbox access routines # @@ -51,10 +35,10 @@ use vars qw($locked_by_file $locked_by_flock); # local_get_msg(src, dst, how) # check, from, get # -sub local_get_msg ($$$$$) { - my ($src, $dst, $how, $lock_type, $noscan) = @_; - my ($need_lock, $qmail_ok, $msgs, $l, $file, $p); - my (@MailDrops); +sub local_get_msg($$$$$) { + my($src, $dst, $how, $lock_type, $noscan) = @_; + my($need_lock, $qmail_ok, $msgs, $l, $file, $p); + my(@MailDrops); if ($how eq 'get') { $need_lock = 1; @@ -89,7 +73,7 @@ sub local_get_msg ($$$$$) { push(@MailDrops, $ENV{'MAIL'}) if ($ENV{'MAIL'}); push(@MailDrops, "$home/Maildir"); foreach $p (@MailDrops) { - if (( -d $p && -d "$p/new" && -d "$p/cur") || -f $p ) { + if ((-d $p && -d "$p/new" && -d "$p/cur") || -f $p) { $mbox = $p; last; } @@ -104,7 +88,7 @@ sub local_get_msg ($$$$$) { ); unshift(@MailDrops, "$home/Mailbox") if ($qmail_ok); foreach $p (@MailDrops) { - if ( -f $p ) { + if (-f $p) { $mbox = $p; last; } @@ -221,7 +205,7 @@ sub local_get_msg ($$$$$) { } } - truncate (SAVE, tell(SAVE)); + truncate(SAVE, tell(SAVE)); unlink($tmpmbox); } else { if (($msgs = process_mbox($mbox, $dst, $how, '', $noscan)) < 0) { @@ -246,8 +230,8 @@ sub local_get_msg ($$$$$) { } } -sub local_copymbox ($$) { - my ($src, $dst) = @_; +sub local_copymbox($$) { + my($src, $dst) = @_; im_debug("copy from $src to $dst\n") if (&debug('local')); unless (im_open(\*SRC, "<$src")) { @@ -274,15 +258,15 @@ sub local_copymbox ($$) { return -1; } } - truncate (DST, -s SRC); - close (DST); - close (SRC); + truncate(DST, -s SRC); + close(DST); + close(SRC); return 0; } -sub process_maildir ($$$$) { - my ($maildir, $dst, $how, $noscan) = @_; - my ($msgs, $f, $dir); +sub process_maildir($$$$) { + my($maildir, $dst, $how, $noscan) = @_; + my($msgs, $f, $dir); unless (-d "$maildir/new" && -r "$maildir/new" && -x "$maildir/new" && -d "$maildir/cur" && -r "$maildir/cur" && -x "$maildir/cur") { @@ -317,10 +301,10 @@ sub process_maildir ($$$$) { return $msgs; } -sub process_file ($$$$) { - my ($mbox, $dst, $how, $noscan) = @_; - my ($format, $msgs, $rp, $length, $inheader, @Message); - local (*MBOX); +sub process_file($$$$) { + my($mbox, $dst, $how, $noscan) = @_; + my($format, $msgs, $rp, $length, $inheader, @Message); + local(*MBOX); im_notice("opening MBOX ($mbox)\n"); unless (im_open(\*MBOX, "<$mbox")) { @@ -331,8 +315,9 @@ sub process_file ($$$$) { push (@Message, $_); } if ($getchk_hook ne '') { - my $head = lcl_store_header(\@Message); - unless (eval { &getchk_sub($head); }) { + my %head; + lcl_store_header(\%head, \@Message); + unless (eval { &getchk_sub(\%head); }) { close(MBOX); return 1 } @@ -348,11 +333,11 @@ sub process_file ($$$$) { return 0; } -sub process_mbox ($$$$$) { - my ($mbox, $dst, $how, $save, $noscan) = @_; - my ($format, $msgs, $length, $inheader, @Message); - local (*MBOX); - my ($first_line, $FIRST_LINE); +sub process_mbox($$$$$) { + my($mbox, $dst, $how, $save, $noscan) = @_; + my($format, $msgs, $length, $inheader, @Message); + local(*MBOX); + my($first_line, $FIRST_LINE); im_info("Getting new messages from local mailbox into $dst....\n") if ($how eq 'get'); @@ -416,7 +401,7 @@ sub process_mbox ($$$$$) { && /^From / && $Message[$#Message] eq "\n") { chomp($first_line = $_); last; - } elsif ($format eq 'RMAIL' && /^\x1f/ ) { + } elsif ($format eq 'RMAIL' && /^\x1f/) { chomp($first_line = <MBOX>); last; } elsif ($inheader) { @@ -424,7 +409,7 @@ sub process_mbox ($$$$$) { print "$_" if (/^From:/i); } # XXX continuous line processing needed - push (@Message, $_) + push(@Message, $_) unless (/^Return-Path:/i && $main::opt_rpath eq 'replace'); # for Solaris 2.x or ... # XXX option @@ -433,13 +418,13 @@ sub process_mbox ($$$$$) { } $inheader = 0 if (/^\n$/); } else { - push (@Message, $_); + push(@Message, $_); $length -= length($_) if ($length > 0); } } if ($Message[$#Message] eq "\n") { - pop (@Message); + pop(@Message); } if ($getchk_hook) { @@ -475,8 +460,8 @@ sub process_mbox ($$$$$) { return $msgs; } -sub save_message ($$$$) { - my ($msg, $save, $mode, $fline) = @_; +sub save_message($$$$) { + my($msg, $save, $mode, $fline) = @_; im_debug("saving to $save\n") if (&debug('local')); if ($mode eq 'UNIX') { @@ -527,7 +512,7 @@ sub save_message ($$$$) { return 0; } -sub local_empty ($) { +sub local_empty($) { my $mbox = shift; unless (truncate($mbox, 0)) { unless (im_open(\*MBOX, ">$mbox")) { @@ -544,15 +529,15 @@ sub LOCK_EX { 2 } sub LOCK_NB { 4 } sub LOCK_UN { 8 } -sub local_lockmbox ($$) { - my ($base, $type) = @_; +sub local_lockmbox($$) { + my($base, $type) = @_; my $retry = 0; im_warn("creating lock file with uid=$> gid=$)\n") if (&debug('local')); $locked_by_file = 0; $locked_by_flock = 0; if ($type =~ /file/) { -# while (! sysopen(LOCK, "$base.lock", O_RDWR()|O_CREAT()|O_EXCL())) { +# while (!sysopen(LOCK, "$base.lock", O_RDWR()|O_CREAT()|O_EXCL())) { # if ($retry >= 10) { # im_warn("can't create $base.lock: $!\n"); # return -1; @@ -589,7 +574,7 @@ sub local_lockmbox ($$) { im_err "can't open $base :$!\n"; return -1; } - if (! &win95p ){ + if (! &win95p) { unless (flock (LOCK_FH, LOCK_EX|LOCK_NB)) { im_warn "can't flock $base: $!\n"; return -1; @@ -600,7 +585,7 @@ sub local_lockmbox ($$) { return 0; } -sub local_unlockmbox ($) { +sub local_unlockmbox($) { my $base = shift; my $rcode = 0; im_debug("removing lock file with uid=$> gid=$)\n") if (&debug('local')); @@ -612,7 +597,7 @@ sub local_unlockmbox ($) { $locked_by_file = 0; } if ($locked_by_flock) { - if (! &win95p ){ + if (! &win95p) { flock(LOCK_FH, LOCK_UN); } $locked_by_flock = 0; @@ -620,9 +605,9 @@ sub local_unlockmbox ($) { return $rcode; } -sub lcl_store_header ($$) { - my ($href, $msg) = @_; - my ($line); +sub lcl_store_header($$) { + my($href, $msg) = @_; + my($line); foreach (@$msg) { my $l = $_; @@ -640,8 +625,8 @@ sub lcl_store_header ($$) { lcl_set_line($href, $line); } -sub lcl_set_line ($$) { - my ($href, $line) = @_; +sub lcl_set_line($$) { + my($href, $line) = @_; return unless ($line =~ /^([^:]*):\s*(.*)$/); my $label = lc($1); @@ -660,6 +645,39 @@ sub lcl_set_line ($$) { 1; +__END__ + +=head1 NAME + +IM::LocalMbox - local mailbox managing + +=head1 SYNOPSIS + + use IM::LocalMbox; + + $num_msgs = &local_get_msg(source_mailbox, destination_folder, access_mode); + +=head1 DESCRIPTION + +The I<IM::LocalMbox> module handles local mailbox. +MH folder, MMDF file, mbox, and Maildir are supported. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + $mbox = 'local:/var/mail/motonori'; + $folder = '+inbox' + $num_msgs = &local_get_msg($mbox, $folder, 'get'); + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Log.pm b/img/lib/IM/Log.pm index 0bb84e07..256fe9da 100644 --- a/img/lib/IM/Log.pm +++ b/img/lib/IM/Log.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Log.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Log.pm version 20021207(IM142)"; package IM::Log; require 5.003; @@ -23,16 +23,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(log_action); -=head1 NAME - -Log - IM log_action - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw($initialized); ##### WRITE DISPATCHING ACTION HISTORY ##### # @@ -43,9 +33,9 @@ use vars qw($initialized); # to: list of recipients # return value: none # -sub log_action ($$$$;@) { - my ($proto, $server, $to, $stat, @resp) = @_; -# my ($proto, $server, $id, $to, $stat, @resp) = @_; +sub log_action($$$$;@) { + my($proto, $server, $to, $stat, @resp) = @_; +# my($proto, $server, $id, $to, $stat, @resp) = @_; return if ($main::Log_file eq '' && !$main::opt_syslog); @@ -73,7 +63,7 @@ sub log_action ($$$$;@) { } } - my ($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year) + my($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year) = localtime(time); my $msg = ''; $msg = sprintf "%d/%02d/%02d %02d:%02d:%02d ", @@ -119,6 +109,33 @@ sub log_action ($$$$;@) { 1; +__END__ + +=head1 NAME + +IM::Log - IM log handler + +=head1 SYNOPSIS + + use IM::Log; + + $main::Log_file = "putlog"; + log_action($proto, $server, $to, $stat, @resp); + +=head1 DESCRIPTION + +The I<IM::Log> module handles log file of IM. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/MD5.pm b/img/lib/IM/MD5.pm index ba9fe4f7..3c995b28 100644 --- a/img/lib/IM/MD5.pm +++ b/img/lib/IM/MD5.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::MD5.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::MD5.pm version 20021207(IM142)"; package IM::MD5; require 5.003; @@ -21,30 +21,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(md5_str); -=head1 NAME - -MD5 - The MD5 Message-Digesting package - -=head1 SYNOPSIS - - use IM::MD5; - - $digest = &md5_str($text); - -=head1 DESCRIPTION - - &md5_str("") returns d41d8cd98f00b204e9800998ecf8427e. - &md5_str("a") returns 0cc175b9c0f1b6a831c399e269772661. - &md5_str("abc") returns 900150983cd24fb0d6963f7d28e17f72. - &md5_str("message digest") returns f96b697d7cb7938d525a2f31aaf161d0. - &md5_str("abcdefghijklmnopqrstuvwxyz") returns c3fcd3d76192e4007dfb496cca67e13b. - &md5_str("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") returns d174ab98d277d9f5a5611c2c9f419d9f. - &md5_str("12345678901234567890123456789012345678901234567890123456789012345678901234567890") returns 57edf4a22be3c955ac49da2e2107b67a. - - % perl -MIM::MD5 -e 'IM::MD5::MD5_TEST()' - -=cut - use vars qw($MD5_S11 $MD5_S12 $MD5_S13 $MD5_S14 $MD5_S21 $MD5_S22 $MD5_S23 $MD5_S24 $MD5_S31 $MD5_S32 $MD5_S33 $MD5_S34 @@ -54,11 +30,11 @@ use vars qw($MD5_S11 $MD5_S12 $MD5_S13 $MD5_S14 # MD5 routines # ################ -sub md5_str ($) { +sub md5_str($) { my($str) = @_; my($len); - my (@context_count, @context_state, @context_buffer); - my (@digest); + my(@context_count, @context_state, @context_buffer); + my(@digest); $len = length($str); my @string = unpack('C*', $str); @@ -69,41 +45,10 @@ sub md5_str ($) { &MD5Final(\@digest, \@context_count, \@context_state, \@context_buffer); return unpack('H*', pack('C*', @digest)); - } +} ############################################################################### -### -### md5.pl -- MD5 message-digest algorithm converted to Perl4 from C version -### -### Copyright (C) 1996 by NAKAMURA, Motonori <motonori@econ.kyoto-u.ac.jp>. -### All rights reserved. -### [August 16, 1996] - -# MD5C.C - RSA Data Security, Inc., MD5 message-digest algorithm - -# Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All -# rights reserved. - -# License to copy and use this software is granted provided that it -# is identified as the "RSA Data Security, Inc. MD5 Message-Digest -# Algorithm" in all material mentioning or referencing this software -# or this function. - -# License is also granted to make and use derivative works provided -# that such works are identified as "derived from the RSA Data -# Security, Inc. MD5 Message-Digest Algorithm" in all material -# mentioning or referencing the derived work. - -# RSA Data Security, Inc. makes no representations concerning either -# the merchantability of this software or the suitability of this -# software for any particular purpose. It is provided "as is" -# without express or implied warranty of any kind. - -# These notices must be retained in any copies of any part of this -# documentation and/or software. - - # F, G, H and I are basic MD5 functions. sub MD5_F {my($x, $y, $z) = @_; ((($x) & ($y)) | (&MD5_trunc(~$x) & ($z))); } @@ -130,19 +75,19 @@ sub MD5_FF { $a = &MD5_trunc($a + &MD5_F($b, $c, $d) + $x + $ac); $a = &MD5_ROTATE_LEFT($a, $s); $a = &MD5_trunc($a + $b); - } +} sub MD5_GG { my($a, $b, $c, $d, $x, $s, $ac) = @_; $a = &MD5_trunc($a + &MD5_G($b, $c, $d) + $x + $ac); $a = &MD5_ROTATE_LEFT($a, $s); $a = &MD5_trunc($a + $b); - } +} sub MD5_HH { my($a, $b, $c, $d, $x, $s, $ac) = @_; $a = &MD5_trunc($a + &MD5_H($b, $c, $d) + $x + $ac); $a = &MD5_ROTATE_LEFT($a, $s); $a = &MD5_trunc($a + $b); - } +} sub MD5_II { my($a, $b, $c, $d, $x, $s, $ac) = @_; $a = &MD5_trunc($a + &MD5_I($b, $c, $d) + $x + $ac); @@ -168,8 +113,8 @@ sub MD5_trunc { # MD5 initialization. Begins an MD5 operation, writing a new context. -sub MD5Init ($$$) { - my ($context_count, $context_state, $context_buffer) = @_; +sub MD5Init($$$) { + my($context_count, $context_state, $context_buffer) = @_; # Constants for MD5Transform routine. $MD5_S11 = 7; @@ -208,10 +153,10 @@ sub MD5Init ($$$) { # operation, processing another message block, and updating the # context. -sub MD5Update ($$$$$) { - my ($context_count, $context_state, $context_buffer, +sub MD5Update($$$$$) { + my($context_count, $context_state, $context_buffer, $input, $inputLen) = @_; - my (@arg1, @arg2); + my(@arg1, @arg2); my($i, $index, $partLen); # Compute number of bytes mod 64 @@ -255,9 +200,9 @@ sub MD5Update ($$$$$) { # MD5 finalization. Ends an MD5 message-digest operation, writing the # the message digest and zeroizing the context. -sub MD5Final ($$$$) { - my ($digest, $context_count, $context_state, $context_buffer) = @_; - my (@bits); +sub MD5Final($$$$) { + my($digest, $context_count, $context_state, $context_buffer) = @_; + my(@bits); my($index, $padLen); @bits = ((0) x 8); @@ -284,13 +229,13 @@ sub MD5Final ($$$$) { # MD5 basic transformation. Transforms state based on block. -sub MD5Transform ($$) { - my ($state, $block) = @_; +sub MD5Transform($$) { + my($state, $block) = @_; my($a) = $state->[0]; my($b) = $state->[1]; my($c) = $state->[2]; my($d) = $state->[3]; - my (@x); + my(@x); &MD5_Decode(\@x, $block, 64); @@ -378,8 +323,8 @@ sub MD5Transform ($$) { # Encodes input (UINT4) into output (unsigned char). Assumes len is # a multiple of 4. -sub MD5_Encode ($$$) { - my ($output, $input, $len) = @_; +sub MD5_Encode($$$) { + my($output, $input, $len) = @_; my($i, $j); for ($i = 0, $j = 0; $j < $len; $i++, $j += 4) { @@ -393,8 +338,8 @@ sub MD5_Encode ($$$) { # Decodes input (unsigned char) into output (UINT4). Assumes len is # a multiple of 4. -sub MD5_Decode ($$$) { - my ($output, $input, my $len) = @_; +sub MD5_Decode($$$) { + my($output, $input, my $len) = @_; my($i, $j); for ($i = 0, $j = 0; $j < $len; $i++, $j += 4) { @@ -405,8 +350,8 @@ sub MD5_Decode ($$$) { # Note: Replace "for loop" with standard memcpy if possible. -sub MD5_memcpy ($$$) { - my ($output, $input, $len) = @_; +sub MD5_memcpy($$$) { + my($output, $input, $len) = @_; my($i); for ($i = 0; $i < $len; $i++) { @@ -416,8 +361,8 @@ sub MD5_memcpy ($$$) { # Note: Replace "for loop" with standard memset if possible. -sub MD5_memset ($$$) { - my ($output, $value, $len) = @_; +sub MD5_memset($$$) { + my($output, $value, $len) = @_; my($i); for ($i = 0; $i < $len; $i++) { @@ -430,8 +375,8 @@ use SelfLoader; __DATA__ sub MD5_CHECK { - my ($str, $should) = @_; - my ($r) = &md5_str($str); + my($str, $should) = @_; + my($r) = &md5_str($str); printf "MD5 (\"%s\") = %s", $str, $r; if ($r eq $should) { @@ -442,7 +387,7 @@ sub MD5_CHECK { } sub MD5_TEST { - my (%v); + my(%v); $v{""} = "d41d8cd98f00b204e9800998ecf8427e"; $v{"a"} = "0cc175b9c0f1b6a831c399e269772661"; $v{"abc"} = "900150983cd24fb0d6963f7d28e17f72"; @@ -457,6 +402,78 @@ sub MD5_TEST { } } +1; + +__END__ + +=head1 NAME + +IM::MD5 - MD5 message-digesting + +=head1 SYNOPSIS + + use IM::MD5; + + $digest = &md5_str($text); + +=head1 DESCRIPTION + +The I<IM::MD5> module handles MD5 message-digest algorithm. + +This modules is provided by IM (Internet Message). + +=head1 EXAMPLES + + &md5_str("") returns d41d8cd98f00b204e9800998ecf8427e. + &md5_str("a") returns 0cc175b9c0f1b6a831c399e269772661. + &md5_str("abc") returns 900150983cd24fb0d6963f7d28e17f72. + &md5_str("message digest") returns f96b697d7cb7938d525a2f31aaf161d0. + &md5_str("abcdefghijklmnopqrstuvwxyz") returns c3fcd3d76192e4007dfb496cca67e13b. + &md5_str("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") returns d174ab98d277d9f5a5611c2c9f419d9f. + &md5_str("12345678901234567890123456789012345678901234567890123456789012345678901234567890") returns 57edf4a22be3c955ac49da2e2107b67a. + + % perl -MIM::MD5 -e 'IM::MD5::MD5_TEST()' + +=head1 COPYRIGHT + +This modules is derived from md5.pl copyrighted by NAKAMURA, Motonori +<motonori@econ.kyoto-u.ac.jp>. It is converted to Perl4 from C version +derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm. + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + +### md5.pl -- MD5 message-digest algorithm converted to Perl4 from C version +### +### Copyright (C) 1996 by NAKAMURA, Motonori <motonori@econ.kyoto-u.ac.jp>. +### All rights reserved. +### [August 16, 1996] +### +### MD5C.C - RSA Data Security, Inc., MD5 message-digest algorithm +### +### Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All +### rights reserved. +### +### License to copy and use this software is granted provided that it +### is identified as the "RSA Data Security, Inc. MD5 Message-Digest +### Algorithm" in all material mentioning or referencing this software +### or this function. +### +### License is also granted to make and use derivative works provided +### that such works are identified as "derived from the RSA Data +### Security, Inc. MD5 Message-Digest Algorithm" in all material +### mentioning or referencing the derived work. +### +### RSA Data Security, Inc. makes no representations concerning either +### the merchantability of this software or the suitability of this +### software for any particular purpose. It is provided "as is" +### without express or implied warranty of any kind. +### +### These notices must be retained in any copies of any part of this +### documentation and/or software. ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. diff --git a/img/lib/IM/Message.pm b/img/lib/IM/Message.pm index c96afaa4..04d8e4e4 100644 --- a/img/lib/IM/Message.pm +++ b/img/lib/IM/Message.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Message.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Message.pm version 20021207(IM142)"; package IM::Message; require 5.003; @@ -48,16 +48,6 @@ use vars qw(@ISA @EXPORT); sort_header ); -=head1 NAME - -Message - IM Message - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw($First_body_line $First_part_mid $bcc_mid $crlf_char @Week_str @Month_str $Cur_time @@ -65,7 +55,7 @@ use vars qw($First_body_line $First_part_mid @Week_str = qw(Sun Mon Tue Wed Thu Fri Sat); @Month_str = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); -sub cur_time ($) { +sub cur_time($) { my $part = shift; return $Cur_time if ($Cur_time && $part == 0); return $Cur_time = time; @@ -80,10 +70,10 @@ sub cur_time ($) { # 0: success # -1: failure # -sub read_header (*$$) { +sub read_header(*$$) { local *CHAN = shift; - my ($Header, $dist_append) = @_; - my ($inheader, $line) = (1, ''); + my($Header, $dist_append) = @_; + my($inheader, $line) = (1, ''); $First_body_line = ''; local $_ = <CHAN>; @@ -134,9 +124,9 @@ sub read_header (*$$) { # -1: failed # 0: success # -sub rewrite_header ($) { +sub rewrite_header($) { my $Header = shift; - my ($i, $val); + my($i, $val); local $_; my $e = $#$Header; # do not evaluate in the loop @@ -173,9 +163,9 @@ sub rewrite_header ($) { # append_default: append default domain name for local names if true # return value: rewritten addresses (NULL if error) # -sub rewrite_addr_list ($$$;$) { - my ($Header, $sender_flag, $addr_list, $def_append) = @_; - my ($line, $ret, $addr, $a, $b, $err); +sub rewrite_addr_list($$$;$) { + my($Header, $sender_flag, $addr_list, $def_append) = @_; + my($line, $ret, $addr, $a, $b, $err); $addr_list =~ s/^\s+//; $addr_list =~ s/\s+$//; @@ -224,7 +214,7 @@ sub rewrite_addr_list ($$$;$) { $b = "$a\@$main::Default_to_domain_name"; $addr = &replace_addr($addr, $a, $b); } - } elsif ($b = hosts_completion($a,$main::Cmpl_with_gethostbyname)){ + } elsif ($b = hosts_completion($a,$main::Cmpl_with_gethostbyname)) { $addr = &replace_addr($addr, $a, $b); } } @@ -241,7 +231,7 @@ sub rewrite_addr_list ($$$;$) { # rewrite_resend_header() # return value: none # -sub rewrite_resend_header ($) { +sub rewrite_resend_header($) { my $Header = shift; my $i; @@ -262,10 +252,10 @@ sub rewrite_resend_header ($) { # 0: success # -1: failure # -sub put_header (*$$$) { +sub put_header(*$$$) { local *CHAN = shift; - my ($Header, $proto, $sel) = @_; - my ($line, $del, $s); + my($Header, $proto, $sel) = @_; + my($line, $del, $s); my $crlf = &crlf; im_debug("entering put_header ($sel)\n") @@ -332,9 +322,9 @@ sub put_header (*$$$) { # term_dot: terminating dot protocol is used if true # return value: none # -sub read_body (*$$$) { +sub read_body(*$$$) { local *CHAN = shift; - my ($Body, $hidden_dot, $term_dot) = @_; + my($Body, $hidden_dot, $term_dot) = @_; local $_; @$Body = (); @@ -364,9 +354,9 @@ sub read_body (*$$$) { # content: pointer to body content line list # return value: none # -sub body_qp_encode ($) { +sub body_qp_encode($) { my $Body = shift; - my ($i, $line, $pos); + my($i, $line, $pos); for ($i = 0; $i <= $#$Body; $i++) { $line = $$Body[$i]; @@ -396,10 +386,10 @@ sub body_qp_encode ($) { # content: pointer to body content line list # return value: none # -sub body_base64_encode ($) { +sub body_base64_encode($) { my $Body = shift; my $line = ''; - my ($i, $tmp, @Body_tmp); + my($i, $tmp, @Body_tmp); require IM::EncDec && import IM::EncDec qw(b_encode_string); @@ -429,10 +419,10 @@ sub body_base64_encode ($) { # 0: success # -1: failure # -sub put_body (*$$$) { +sub put_body(*$$$) { local *CHAN = shift; - my ($Body, $hidden_dot, $part) = @_; - my ($start, $end, $i, $line); + my($Body, $hidden_dot, $part) = @_; + my($start, $end, $i, $line); my $crlf= &crlf; if ($part == 0) { @@ -471,9 +461,9 @@ sub put_body (*$$$) { # 0: success # -1: failure # -sub put_mimed_bcc (*$$$$$$) { +sub put_mimed_bcc(*$$$$$$) { local *CHAN = shift; - my ($Header, $Body, $proto, $hidden_dot, $part, $total) = @_; + my($Header, $Body, $proto, $hidden_dot, $part, $total) = @_; my $subj; my $crlf = &crlf; @@ -538,9 +528,9 @@ sub put_mimed_bcc (*$$$$$$) { # 0: success # -1: failure # -sub put_mimed_partial (*$$$$$$) { +sub put_mimed_partial(*$$$$$$) { local *CHAN = shift; - my ($Header, $Body, $proto, $hidden_dot, $part, $total) = @_; + my($Header, $Body, $proto, $hidden_dot, $part, $total) = @_; my $crlf = &crlf; return -1 if (&put_header(\*CHAN, $Header, $proto, 'partial:ext') < 0); @@ -583,10 +573,10 @@ sub put_mimed_partial (*$$$$$$) { # 0: success # -1: failure # -sub put_mimed_error_notify (*$$$$$$$$;$) { +sub put_mimed_error_notify(*$$$$$$$$;$) { local *CHAN = shift; - my ($Header, $Body, $Recp, $Stat, $proto, $server, - $hidden_dot, $session_log, $part) = @_; # XXX: $part missing? + my($Header, $Body, $Recp, $Stat, $proto, $server, + $hidden_dot, $session_log, $part) = @_; # XXX: $part missing? my $subj; my $crlf = &crlf; my $boundary; @@ -639,7 +629,7 @@ sub put_mimed_error_notify (*$$$$$$$$;$) { # host information my $myhostname = hostname(); unless ($myhostname =~ /\./) { - my ($h) = gethostbyname($myhostname); + my($h) = gethostbyname($myhostname); $myhostname = $h if ($h); } @@ -684,9 +674,9 @@ sub put_mimed_error_notify (*$$$$$$$$;$) { # body: reference to a message body array # return value: size of whole message # -sub message_size ($$$) { - my ($Header, $Body, $part) = @_; - my ($start, $end, $i, $size); +sub message_size($$$) { + my($Header, $Body, $part) = @_; + my($start, $end, $i, $size); if ($part == 0) { $start = 0; @@ -706,11 +696,11 @@ sub message_size ($$$) { return $size; } -sub set_crlf ($) { +sub set_crlf($) { $crlf_char = shift; } -sub crlf () { +sub crlf() { $crlf_char; } @@ -720,14 +710,14 @@ sub crlf () { # part: part number of partial messages (for reuse) # return value: a unique message-id string # -sub gen_message_id ($) { +sub gen_message_id($) { my $part = shift; return $Mid_hist{$part} if ($part > 0 && $Mid_hist{$part}); - my ($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year) + my($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year) = localtime(&cur_time($part)); - my ($mid_time) = sprintf("%d%02d%02d%02d%02d%02d", + my($mid_time) = sprintf("%d%02d%02d%02d%02d%02d", $tm_year+1900, $tm_mon+1, $tm_mday, $tm_hour, $tm_min, $tm_sec); - my ($mid_rnd) = sprintf("%c", 0x41 + rand(26)); + my($mid_rnd) = sprintf("%c", 0x41 + rand(26)); if ($Prev_mid_time eq $mid_time) { while ($mid_rnd =~ /[$Mid_rnd_hist]/) { $mid_rnd = sprintf("%c", 0x41 + rand(26)); @@ -746,7 +736,7 @@ sub gen_message_id ($) { } else { $mid_user = $main::Login; } - my ($mid) + my($mid) = "<$mid_time$mid_rnd.$mid_user\@$main::Message_id_domain_name>"; $Mid_hist{$part} = $mid if ($part > 0); return $mid; @@ -761,10 +751,10 @@ sub gen_message_id ($) { # 2 = "WWW MMM DD HH:MM:SS YYYY" (mainly for UNIX From) # return value: date string generated with current time # -sub gen_date ($) { +sub gen_date($) { my $format = shift; - my ($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year, - $tm_wk, $tm_yday, $tm_isdst, $tm_tz); + my($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year, + $tm_wk, $tm_yday, $tm_isdst, $tm_tz); if ($main::NewsGMTdate && $main::News_flag) { ($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year, $tm_wk, $tm_yday) = gmtime(&cur_time(0)); @@ -787,8 +777,8 @@ sub gen_date ($) { } } } else { - my ($gm_sec, $gm_min, $gm_hour, $gm_mday, $gm_mon, - $gm_year, $gm_wk, $gm_yday) = gmtime(&cur_time(0)); + my($gm_sec, $gm_min, $gm_hour, $gm_mday, $gm_mon, + $gm_year, $gm_wk, $gm_yday) = gmtime(&cur_time(0)); $off = ($tm_hour - $gm_hour) * 60 + $tm_min - $gm_min; if ($tm_year < $gm_year) { $off -= 24 * 60; @@ -832,8 +822,8 @@ sub gen_date ($) { # field: field name of which value needed # return value: value for specified field OR null # -sub header_value ($$) { - my ($Header, $field_name) = @_; +sub header_value($$) { + my($Header, $field_name) = @_; my $val; local $_; @@ -855,8 +845,8 @@ sub header_value ($$) { # field_value: field value to be entered with # return value: none # -sub add_header ($$$$) { - my ($Header, $replace_flag, $field_name, $field_value) = @_; +sub add_header($$$$) { + my($Header, $replace_flag, $field_name, $field_value) = @_; $field_value .= "\n" if ($field_value !~ /\n$/); im_debug("adding header> $field_name: $field_value") @@ -881,8 +871,8 @@ sub add_header ($$$$) { # leave_first: leave the first appeared header line if true # return value: none # -sub kill_header ($$$) { - my ($Header, $field_name, $leave_first) = @_; +sub kill_header($$$) { + my($Header, $field_name, $leave_first) = @_; my $i; for ($i = 0; $i <= $#$Header; $i++) { @@ -903,7 +893,7 @@ sub kill_header ($$$) { # header: reference to a message header array # return value: none # -sub kill_empty_header ($) { +sub kill_empty_header($) { my $Header = shift; my $i; @@ -922,12 +912,12 @@ sub kill_empty_header ($) { # name_list: leave the first appeared header line if true # return value: none # -sub sort_header ($$) { - my ($Header, $name_list) = @_; - my ($i, $label, @tail); +sub sort_header($$) { + my($Header, $name_list) = @_; + my($i, $label, @tail); foreach $label (split(',', $name_list)) { - for ($i = 0; $i <= $#$Header; ) { + for ($i = 0; $i <= $#$Header;) { if ($$Header[$i] =~ /^$label:/i) { push (@tail, $$Header[$i]); splice(@$Header, $i, 1); @@ -946,8 +936,8 @@ sub sort_header ($$) { # str2: a header string to be appended to str1 # return value: a concatinated header string # -sub hdr_cat ($$) { - my ($str1, $str2) = @_; +sub hdr_cat($$) { + my($str1, $str2) = @_; if ($str1 eq '' || $str1 =~ /\n[\t ]+$/) { return "$str1$str2"; @@ -964,6 +954,53 @@ sub hdr_cat ($$) { 1; +__END__ + +=head1 NAME + +IM::Message - mail/news message handler + +=head1 SYNOPSIS + + use IM::Message; + +Subroutines: +read_header +message_size +put_header +read_body +put_body +rewrite_header +rewrite_resend_header +body_qp_encode +body_base64_encode +put_mimed_bcc +put_mimed_partial +put_mimed_error_notify +set_crlf +crlf +gen_message_id +gen_date +header_value +add_header +kill_header +kill_empty_header +sort_header + +=head1 DESCRIPTION + +The I<IM::Message> module handles mail/news messages. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/MsgStore.pm b/img/lib/IM/MsgStore.pm index 61a1c90e..9e100293 100644 --- a/img/lib/IM/MsgStore.pm +++ b/img/lib/IM/MsgStore.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::MsgStore.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::MsgStore.pm version 20021207(IM142)"; package IM::MsgStore; require 5.003; @@ -27,16 +27,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(store_message exec_getsbrfile open_fcc excl_create fsync); -=head1 NAME - -MsgStore - store message in MH-style folder - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw($MsgNum $PrevFolder $First $Last $PrevDst $sys_fsync); BEGIN { $MsgNum = 0; @@ -54,7 +44,7 @@ BEGIN { # success: file name to be saved # fail: NULL # -sub new_message (\*$) { +sub new_message(\*$) { (local *MESSAGE, my $folder) = @_; if ($folder ne $PrevFolder) { $MsgNum = 0; @@ -68,7 +58,11 @@ sub new_message (\*$) { } $First = $Last = $MsgNum; } else { - $MsgNum++; + $MsgNum = message_number($folder, 'new', ($MsgNum)); + if ($MsgNum == 0) { + im_warn("can't get new message number in $folder\n"); + return ('', ''); + } } my $try = 3; while ($try--) { @@ -83,15 +77,19 @@ sub new_message (\*$) { $Last = $MsgNum; return ("$folder/$MsgNum", $file); } - $MsgNum++; + $MsgNum = message_number($folder, 'new', ($MsgNum)); + if ($MsgNum == 0) { + im_warn("can't get new message number in $folder\n"); + return ('', ''); + } } im_warn("excl_create failed.\n"); # message creation failed return ('', ''); } -sub store_message ($$;$) { - my ($Msg, $dst, $noscan) = @_; +sub store_message($$;$) { + my($Msg, $dst, $noscan) = @_; local *ART; require IM::Scan && import IM::Scan qw(store_header parse_header parse_body disp_msg); @@ -104,7 +102,7 @@ sub store_message ($$;$) { touch_folder($dst); $PrevDst = $dst; } - my ($msgfile, $filepath) = &new_message(\*ART, $dst); + my($msgfile, $filepath) = &new_message(\*ART, $dst); my $size = 0; if ($filepath ne '') { my $line; @@ -190,7 +188,7 @@ sub store_message ($$;$) { } } -sub exec_getsbrfile ($) { +sub exec_getsbrfile($) { my $dst = shift; my $get_hook = getsbr_file(); if ($get_hook) { @@ -229,9 +227,9 @@ sub exec_getsbrfile ($) { # path: file name to be saved # rm_file_on_error: a path to be deleted on error # -sub open_fcc ($$) { - my ($folder, $dir_style) = @_; - my ($fcc_dir, $rm_file_on_error, $fcc_folder, $FILE, $msgfile); +sub open_fcc($$) { + my($folder, $dir_style) = @_; + my($fcc_dir, $rm_file_on_error, $fcc_folder, $FILE, $msgfile); $fcc_folder = &expand_path($folder); if (-d $fcc_folder) { @@ -286,14 +284,14 @@ sub open_fcc ($$) { # 0: success # -1: fail # -sub excl_create (*$) { +sub excl_create(*$) { (local *MESSAGE, my $file) = @_; msg_mode(1); return -1 unless (im_sysopen(\*MESSAGE, $file, file_attr())); return 0; } -sub fsync ($) { +sub fsync($) { my $fno = shift; if (fsync_no()) { @@ -340,6 +338,33 @@ sub fsync ($) { 1; +__END__ + +=head1 NAME + +IM::MsgStore - store message in MH-style folder + +=head1 SYNOPSIS + + use IM::MsgStore; + +Subroutines: +store_message exec_getsbrfile open_fcc excl_create fsync + +=head1 DESCRIPTION + +The I<IM::MsgStore> module stores mail/news messages in MH-style folder. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Nntp.pm b/img/lib/IM/Nntp.pm index 49b50cd8..9751d9c5 100644 --- a/img/lib/IM/Nntp.pm +++ b/img/lib/IM/Nntp.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Nntp.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Nntp.pm version 20021207(IM142)"; package IM::Nntp; require 5.003; @@ -39,20 +39,6 @@ use vars qw(@ISA @EXPORT); nntp_spec ); -=head1 NAME - -NNTP - NNTP interface package - -=head1 SYNOPSIS - -$return_code = &nntp_transaction(server_list, newsgroups, - part_current, part_total, authuser); -$return_code = &nntp_close; - -=head1 DESCRIPTION - -=cut - use vars qw($Nntp_opened *NNTPd $NntpErrTitle); ##### NNTP SESSION OPENING ##### @@ -64,8 +50,8 @@ use vars qw($Nntp_opened *NNTPd $NntpErrTitle); # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub nntp_open ($$) { - my ($servers, $logging) = @_; +sub nntp_open($$) { + my($servers, $logging) = @_; my $rc; if ($Nntp_opened) { @@ -79,7 +65,7 @@ sub nntp_open ($$) { if ($rc = &tcp_command(\*NNTPd, '', '')) { return $rc; } - my (@resp) = &command_response; + my(@resp) = &command_response; if ($resp[0] =~ /InterNetNews server INN/) { return 1 if (&tcp_command(\*NNTPd, 'MODE reader', '')); } @@ -95,7 +81,7 @@ sub nntp_open ($$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub nntp_close () { +sub nntp_close() { return 0 unless ($Nntp_opened); $Nntp_opened = 0; im_notice("closing NNTP session.\n"); @@ -117,8 +103,8 @@ sub nntp_close () { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub nntp_transaction ($$$$$$$) { - my ($servers, $Header, $Body, $group, $part, $total, $authuser) = @_; +sub nntp_transaction($$$$$$$) { + my($servers, $Header, $Body, $group, $part, $total, $authuser) = @_; my $rc; require IM::Log && import IM::Log; @@ -126,7 +112,7 @@ sub nntp_transaction ($$$$$$$) { &set_nntpauthuser($authuser); do { $rc = &nntp_transact_sub($servers, $Header, $Body, $part, $total); - my (@resp) = &command_response; + my(@resp) = &command_response; if ($rc) { &im_warn($NntpErrTitle . join("\n", @resp) . "\n"); $NntpErrTitle = ''; @@ -153,8 +139,8 @@ sub nntp_transaction ($$$$$$$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub nntp_transact_sub ($$$$$) { - my ($servers, $Header, $Body, $part, $total) = @_; +sub nntp_transact_sub($$$$$) { + my($servers, $Header, $Body, $part, $total) = @_; my $rc; return $rc if ($rc = &nntp_open($servers, 1)); @@ -177,9 +163,9 @@ sub nntp_transact_sub ($$$$$) { return 0; } -sub nntp_head_as_string ($) { +sub nntp_head_as_string($) { my $i = shift; - my ($rc, $count) = ('', 0); + my($rc, $count) = ('', 0); local $_; im_notice("getting article $i.\n"); @@ -190,7 +176,7 @@ sub nntp_head_as_string ($) { return -1; } $count++; - my ($found, $f) = (0, ''); + my($found, $f) = (0, ''); alarm(nntp_timeout()) unless win95p(); $! = 0; while (<NNTPd>) { @@ -211,8 +197,8 @@ sub nntp_head_as_string ($) { return $f; } -sub nntp_head ($$) { - my ($art_start, $art_end) = @_; +sub nntp_head($$) { + my($art_start, $art_end) = @_; local $_; my $count = 0; @@ -226,7 +212,7 @@ sub nntp_head ($$) { return -1; } $count++; - my ($found, $f) = (0, ''); + my($found, $f) = (0, ''); alarm(nntp_timeout()) unless win95p(); $! = 0; while (<NNTPd>) { @@ -257,8 +243,8 @@ sub nntp_head ($$) { return $count; } -sub nntp_xover ($$) { - my ($art_start, $art_end) = @_; +sub nntp_xover($$) { + my($art_start, $art_end) = @_; my $rc = &tcp_command(\*NNTPd, "XOVER $art_start-$art_end", ''); if ($rc) { @@ -266,7 +252,7 @@ sub nntp_xover ($$) { return -1; } my $count = 0; - my ($resp); + my($resp); while (($resp = &next_response(\*NNTPd)) !~ /^\.$/) { $count++; my @overview = split('\t', $resp); @@ -285,17 +271,17 @@ sub nntp_xover ($$) { return $count; } -sub nntp_article ($) { +sub nntp_article($) { my $num = shift; local $_; -# local (@Article); +# local(@Article); im_debug("getting article $num.\n") if (&debug('nntp')); my $rc = &tcp_command(\*NNTPd, "ARTICLE $num", ''); - return (1, '') if ($rc > 0); + return(1, '') if ($rc > 0); if ($rc < 0) { im_warn("ARTICLE command failed.\n"); - return (-1, ''); + return(-1, ''); } my @Article = (); alarm(nntp_timeout()) unless win95p(); @@ -305,7 +291,7 @@ sub nntp_article ($) { alarm(0); if ($!) { # may be channel truoble im_warn("lost connection for ARTICLE.\n"); - return (-1, ''); + return(-1, ''); } } s/\r\n$/\n/; @@ -315,12 +301,12 @@ sub nntp_article ($) { im_debug($_) if (&debug('nntp')); } alarm(0) unless win95p(); - return (0, \@Article); + return(0, \@Article); } -sub nntp_articles ($$$$) { - my ($art_start, $art_end, $dst, $limit) = @_; - my ($rc, $article); +sub nntp_articles($$$$) { + my($art_start, $art_end, $dst, $limit) = @_; + my($rc, $article); my $count = 0; my $last = 0; @@ -343,10 +329,10 @@ sub nntp_articles ($$$$) { last if ($limit && --$limit == 0); } &exec_getsbrfile($dst); - return ($count, $last); + return($count, $last); } -sub nntp_list ($) { +sub nntp_list($) { my $group = shift; local $_; my $rc; @@ -366,13 +352,13 @@ sub nntp_list ($) { return $count; } -sub nntp_command ($) { +sub nntp_command($) { my $cmd = shift; my $rc = &tcp_command(\*NNTPd, $cmd, ''); return -1 if ($rc < 0); if ($rc > 0) { - my ($res) = &command_response(); + my($res) = &command_response(); if ($res =~ /^480/) { require IM::GetPass && import IM::GetPass; @@ -382,7 +368,7 @@ sub nntp_command ($) { my $user = &nntpauthuser() || $ENV{'USER'} || $ENV{'LOGNAME'} || im_getlogin(); my $host = get_cur_server(); - my ($pass, $agtfound, $interact) + my($pass, $agtfound, $interact) = getpass('nntp', 'PASS', $host, $user); # authenticate for posting @@ -398,29 +384,29 @@ sub nntp_command ($) { return $rc; } -sub nntp_command_response () { +sub nntp_command_response() { return &command_response; } -sub nntp_next_response () { +sub nntp_next_response() { return &next_response(\*NNTPd); } -sub set_last_article_number ($$$) { - my ($server, $group, $number) = @_; - my ($pos, $last, $size) = (0, 0, 0); +sub set_last_article_number($$$) { + my($server, $group, $number) = @_; + my($pos, $last, $size) = (0, 0, 0); $server =~ s!\%\d+$!!; $server =~ s!/\d+$!!; my $nntphist = &nntphistoryfile() . '-' . $server; - if ( -f $nntphist ) { + if (-f $nntphist) { im_open(\*NEWSHIST, "+<$nntphist"); while ($pos = tell(NEWSHIST), $_ = <NEWSHIST>) { /^([^:]+):\s*(\d+)/; if ($group eq $1) { $last = $2; im_debug("$last articles in $group ($nntphist)\n") - if(&debug('nntp')); + if (&debug('nntp')); seek(NEWSHIST, $pos, 0); $size = length($_) - length("$group: 0000000\n"); if ($size < 0) { @@ -445,8 +431,8 @@ sub set_last_article_number ($$$) { return $last; } -sub get_last_article_number ($$) { - my ($server, $group) = @_; +sub get_last_article_number($$) { + my($server, $group) = @_; local $_; my $number = 0; @@ -467,33 +453,33 @@ sub get_last_article_number ($$) { } -sub nntp_get_message ($$) { - my ($src, $msg) = @_; - my ($rc, $art); - my ($group, $srvs) = nntp_spec($src, nntpservers()); +sub nntp_get_message($$) { + my($src, $msg) = @_; + my($rc, $art); + my($group, $srvs) = nntp_spec($src, nntpservers()); my @servers = split(',', $srvs); im_notice("accessing to $group on $srvs.\n"); do { if (($rc = nntp_open(\@servers, 0)) < 0) { - return (-1, "can not connect $srvs.\n"); + return(-1, "can not connect $srvs.\n"); } if (($group ne '') && ($rc = nntp_command("GROUP $group")) < 0) { - return (-1, "can not access $group.\n"); + return(-1, "can not access $group.\n"); } } while (@servers > 0 && $rc > 0); - return (-1, "can not access $group on $srvs.\n") if ($rc); + return(-1, "can not access $group on $srvs.\n") if ($rc); ($rc, $art) = nntp_article($msg); nntp_close(); - return (-1, "no message $msg in -$group.\n") if ($rc); - return (0, $art); + return(-1, "no message $msg in -$group.\n") if ($rc); + return(0, $art); } # returns number of got articles # -1 if error -sub nntp_get_msg ($$$$) { - my ($src, $dst, $how, $limit) = @_; - my ($rc, $group, $error, $art_start, $art_end); - my ($servers, @servers); +sub nntp_get_msg($$$$) { + my($src, $dst, $how, $limit) = @_; + my($rc, $group, $error, $art_start, $art_end); + my($servers, @servers); if ($src =~ /^nntp:(.*)/i || $src =~ /^news:(.*)/i) { ($group, $servers) = &nntp_spec($1, nntpservers()); @@ -514,7 +500,7 @@ sub nntp_get_msg ($$$$) { } while (@servers > 0 && $rc > 0); return -1 if ($rc); - my (@resp) = &command_response; + my(@resp) = &command_response; $error = 0; my $i; for ($i = 0; $i <= $#resp; $i++) { @@ -535,7 +521,7 @@ sub nntp_get_msg ($$$$) { return -1; } - my ($art_last, $msgs); + my($art_last, $msgs); $art_last = &get_last_article_number($servers, $group); if ($art_end > $art_last) { # new articles @@ -587,7 +573,7 @@ sub nntp_get_msg ($$$$) { } if ($how eq 'get') { - my ($last); + my($last); if ($msgs > 0) { im_info("Getting new messages from $group at $servers " . "into $dst....\n"); @@ -609,8 +595,8 @@ sub nntp_get_msg ($$$$) { } # News group (-group[@server]) -sub nntp_spec ($$) { - my ($spec, $server) = @_; +sub nntp_spec($$) { + my($spec, $server) = @_; my $group; if ($spec =~ /^-(.*)/) { @@ -621,11 +607,51 @@ sub nntp_spec ($$) { } else { $group = $spec; } - return ($group, $server); + return($group, $server); } 1; +__END__ + +=head1 NAME + +IM::Nntp - NNTP hanlder + +=head1 SYNOPSIS + + use IM::Nntp; + + $return_code = &nntp_transaction(server_list, newsgroups, + part_current, part_total, authuser); + $return_code = &nntp_close; + +Other subroutines: +nntp_open +nntp_article +nntp_list +nntp_command +nntp_command_response +nntp_next_response +nntp_get_message +nntp_get_msg +nntp_head_as_string +nntp_spec + +=head1 DESCRIPTION + +The I<IM::Nntp> module handles NNTP. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Pop.pm b/img/lib/IM/Pop.pm index feb28f22..8486edaa 100644 --- a/img/lib/IM/Pop.pm +++ b/img/lib/IM/Pop.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Pop.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Pop.pm version 20021207(IM142)"; package IM::Pop; require 5.003; @@ -27,16 +27,6 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(pop_get_msg pop_spec); -=head1 NAME - -Pop - POP handling package - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw(*POPd $SERVER_IDENT %history %newhistory); ####################### # POP access routines # @@ -54,11 +44,11 @@ use vars qw(*POPd $SERVER_IDENT %history %newhistory); # -1: failure # -2: failure (connection) # -sub pop_open ($$$$) { - my ($auth, $host, $user, $pass) = @_; +sub pop_open($$$$) { + my($auth, $host, $user, $pass) = @_; my $prompt = lc("pop/$auth:$user\@$host"); - my ($resp, $pwd, $errmsg); - my (@host_list) = ($host); + my($resp, $pwd, $errmsg); + my(@host_list) = ($host); im_notice("opening POP session ($auth)\n"); if ($auth eq 'RPOP' && !$main::SUIDROOT) { im_warn("RPOP operation requires SUID root.\n"); @@ -126,7 +116,7 @@ sub pop_open ($$$$) { return 0; } -sub pop_close () { +sub pop_close() { im_notice("closing POP session.\n"); my $resp = &send_command(\*POPd, 'QUIT', ''); return -1 if ($resp !~ /^\+/); @@ -134,8 +124,8 @@ sub pop_close () { return 0; } -sub pop_stat () { - my (@field); +sub pop_stat() { + my(@field); im_notice("getting number of message.\n"); my $resp = &send_command(\*POPd, 'STAT', ''); if ($resp !~ /^\+/) { @@ -147,10 +137,10 @@ sub pop_stat () { return $field[1]; } -sub pop_retr ($$$) { - my ($num, $dst, $noscan) = @_; - local ($_); - my (@Message); +sub pop_retr($$$) { + my($num, $dst, $noscan) = @_; + local($_); + my(@Message); im_notice("getting message $num.\n"); my $resp = &send_command(\*POPd, "RETR $num", ''); if ($resp !~ /^\+/) { @@ -181,7 +171,7 @@ sub pop_retr ($$$) { return 0; } -sub pop_head ($) { +sub pop_head($) { my $num = shift; im_notice("getting header of message $num.\n"); my $resp = &send_command(\*POPd, "TOP $num 1", ''); @@ -189,9 +179,9 @@ sub pop_head ($) { im_warn("TOP command failed.\n"); return 0; } - my ($field, $inheader) = ('', 1); - local ($_); - my (%head); + my($field, $inheader) = ('', 1); + local($_); + my(%head); undef %head; alarm(pop_timeout()) unless win95p(); $! = 0; @@ -227,7 +217,7 @@ sub pop_head ($) { return \%head; } -sub pop_dele ($) { +sub pop_dele($) { my $num = shift; im_notice("deleting message $num.\n"); my $resp = &send_command(\*POPd, "DELE $num", ''); @@ -238,7 +228,7 @@ sub pop_dele ($) { return 0; } -sub pop_uidl ($) { +sub pop_uidl($) { my $uidlp = shift; local $_; im_notice("getting UIDL information.\n"); @@ -269,9 +259,9 @@ sub pop_uidl ($) { } # pop_process(socket, how) -sub pop_process ($$$$) { - my ($how, $host, $dst, $noscan) = @_; - my ($histfile, $head, $msgs, $i, $h, $new, $last); +sub pop_process($$$$) { + my($how, $host, $dst, $noscan) = @_; + my($histfile, $head, $msgs, $i, $h, $new, $last); return -1 if (($msgs = &pop_stat) < 0); my $keep_proto = 'UIDL'; # UIDL/LAST/STATUS/MSGID @@ -432,9 +422,9 @@ sub pop_process ($$$$) { return $new; } -sub pop_inc ($$$$$$$$) { - my ($msgs, $host, $dst, $last, $keep_proto, $histp, $uidlp, $noscan) = @_; - my ($accesstime, $i, $h, $head); +sub pop_inc($$$$$$$$) { + my($msgs, $host, $dst, $last, $keep_proto, $histp, $uidlp, $noscan) = @_; + my($accesstime, $i, $h, $head); my $got = 0; my $ttl = 0; @@ -530,14 +520,14 @@ sub pop_inc ($$$$$$$$) { return $got; } -sub pop_get_msg ($$$$) { - my ($src, $dst, $how, $noscan) = @_; +sub pop_get_msg($$$$) { + my($src, $dst, $how, $noscan) = @_; $src =~ s/^pop//i; - my ($auth, $user, $host) = &pop_spec($src); + my($auth, $user, $host) = &pop_spec($src); - my ($pass, $agtfound, $interact) = ('', 0, 0); + my($pass, $agtfound, $interact) = ('', 0, 0); ($pass, $agtfound, $interact) = getpass ('pop', $auth, $host, $user) unless $auth eq 'RPOP'; @@ -563,7 +553,7 @@ sub pop_get_msg ($$$$) { } # POP folder (--src=pop[//auth][:user][@server[/port]]) -sub pop_spec ($) { +sub pop_spec($) { my $spec = shift; if ($spec eq '' || $spec !~ /[:\@]|\/\//) { @@ -577,7 +567,7 @@ sub pop_spec ($) { } $spec .= $s if ($s ne ''); } - my ($auth, $host) = ('apop', 'localhost'); + my($auth, $host) = ('apop', 'localhost'); my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || im_getlogin(); if ($spec =~ /^\/\/?(\w+)(.*)/) { @@ -613,6 +603,34 @@ sub pop_spec ($) { 1; +__END__ + +=head1 NAME + +IM::Pop - POP handler + +=head1 SYNOPSIS + + use IM::Pop; + + $msgs = pop_get_msg($src, $dst, $mode, $noscan); + + ($auth, $user, $host) = pop_spec($src) + +=head1 DESCRIPTION + +The I<IM::Pop> module handles Pop. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Recipient.pm b/img/lib/IM/Recipient.pm index 353df12b..7cec8467 100644 --- a/img/lib/IM/Recipient.pm +++ b/img/lib/IM/Recipient.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 27, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Recipient.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Recipient.pm version 20021207(IM142)"; package IM::Recipient; require 5.003; @@ -27,29 +27,19 @@ use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(add_to_rcpt parse_rcpt rcpt_pickup); -=head1 NAME - -Recipient - IM recipient handler - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - use vars qw($Alias_match_count $Include_count %Include_Files); ##### ADD AN ADDRESS TO RECIPIENT LIST ##### # -# add_to_rctp(bcc_flag, addr) +# add_to_rcpt(bcc_flag, addr) # bcc_flag: register with "bcc" tag # addr: an address to be registered # return value: none # 0: success # -1: failure # -sub add_to_rcpt ($$) { - my ($bcc_flag, $addr) = @_; - my ($rec, $a); +sub add_to_rcpt($$) { + my($bcc_flag, $addr) = @_; + my($rec, $a); $addr = &extract_addr($addr); return -1 if ($addr eq ''); return 0 unless ($addr); @@ -89,7 +79,7 @@ sub add_to_rcpt ($$) { ##### PARSE RECIPIENT LIST ##### # -# sub parse_rcpt(bcc_flag, addr_list, need_code_conversion) +# parse_rcpt(bcc_flag, addr_list, need_code_conversion) # bcc_flag: # 1 = BCC distination # 0 = normal distination @@ -97,9 +87,9 @@ sub add_to_rcpt ($$) { # addr_list: address list string (concatinated with ",") # return value: number of addresses in the list (-1 if error) # -sub parse_rcpt ($$$) { - my ($bcc_flag, $addr_list, $conv) = @_; - my ($cnt, $addr); +sub parse_rcpt($$$) { + my($bcc_flag, $addr_list, $conv) = @_; + my($cnt, $addr); $addr_list =~ s/^\s+//; $addr_list =~ s/\n\s*//g; # XXX return 0 if ($addr_list eq ''); @@ -148,13 +138,13 @@ sub parse_rcpt ($$$) { # 0: success # -1: failure # -sub expn_group ($$) { - my ($bcc_flag, $group_expression) = @_; - my ($rest, @mboxes, $rec); +sub expn_group($$) { + my($bcc_flag, $group_expression) = @_; + my($rest, @mboxes, $rec); # return if ($group_expression !~ /:.*;$/); return if ($group_expression !~ /:[^;]*;/); im_debug("expanding $group_expression\n") if (&debug('rcpt')); -# my ($group_name); +# my($group_name); # $group_name = $group_expression; # $group_name =~ s/:.*/:;/; $rest = $group_expression; @@ -181,10 +171,10 @@ sub expn_group ($$) { # 0: success # -1: failure # -sub expn_rcpt_list ($$) { - my ($bcc_flag, $include_file) = @_; - my ($file) = &expand_path($include_file); - my ($INCLUDE) = &include_open($file); +sub expn_rcpt_list($$) { + my($bcc_flag, $include_file) = @_; + my($file) = &expand_path($include_file); + my($INCLUDE) = &include_open($file); if ($INCLUDE) { while (defined($_ = include_readline($INCLUDE))) { chomp; @@ -205,7 +195,7 @@ sub expn_rcpt_list ($$) { } elsif (/^\s*\//) { im_err("Mail to file not supported: $_\n"); return -1; - } elsif (/^\s*\|/ || /^\s*"\s*\|/) { + } elsif (/^\s*\|/ || /^\s*"\s*\|/) { #" im_err("Mail to program not supported: $_\n"); return -1; } @@ -228,8 +218,8 @@ sub expn_rcpt_list ($$) { # -1: failure # 0: success # -sub rcpt_pickup ($$$) { - my ($Header, $resend_flag, $news_only_flag) = @_; +sub rcpt_pickup($$$) { + my($Header, $resend_flag, $news_only_flag) = @_; my $line; my $resend_prefix; @@ -262,25 +252,71 @@ sub rcpt_pickup ($$$) { # return value: handle # no strict 'refs'; -sub include_open ($) { - my ($file) = shift; +sub include_open($) { + my($file) = shift; return undef if $Include_Files{$file}; im_open($file, $file) || return undef; $Include_Files{$file} = 1; return $file; } -sub include_readline ($) { +sub include_readline($) { my $fh = shift; return scalar(<$fh>); } -sub include_close ($) { - my ($fh) = shift; +sub include_close($) { + my($fh) = shift; close($fh); delete $Include_Files{$fh}; } 1; +__END__ + +=head1 NAME + +IM::Recipient - mail/news recipient handler + +=head1 SYNOPSIS + + use IM::Recipient; + + add_to_rcpt(bcc_flag, addr) + bcc_flag: register with "bcc" tag + addr: an address to be registered + return value: none + 0: success + -1: failure + + parse_rcpt(bcc_flag, addr_list, need_code_conversion) + bcc_flag: + 1 = BCC distination + 0 = normal distination + -1 = parse only + addr_list: address list string (concatinated with ",") + return value: number of addresses in the list (-1 if error) + + rcpt_pickup(header, resend_flag, news_only_flag) + resend_flag: pickup addresses for redistributing mode + news_only_flag: do not pickup destination addresses for news mode + return value: + -1: failure + 0: success + +=head1 DESCRIPTION + +The I<IM::Recipient> module handles recipient of mail/news message. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Scan.pm b/img/lib/IM/Scan.pm index 9c14d9c9..c31c0e69 100644 --- a/img/lib/IM/Scan.pm +++ b/img/lib/IM/Scan.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Scan.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Scan.pm version 20021207(IM142)"; package IM::Scan; require 5.003; @@ -28,97 +28,6 @@ use vars qw(@ISA @EXPORT); @EXPORT = qw(set_scan_form get_header store_header parse_body parse_header disp_msg read_petnames); -=head1 NAME - - Scan - Scan listing from mail - -=head1 SYNOPSIS - - use IM::Scan; - - &set_scan_form($scan_form, $width, $use_jis); - &read_petnames(); - %Head = &get_header($mail_file); - &disp_msg(\%Head); - -=head1 DESCRIPTION - -=head1 FILES - - $HOME/.im/Config the user profile - -=head1 PROFILE COMPONENTS - - Component Explanation Example - - MailDir: your mail directory Mail - Width: one line width 80 - JisSafe: safely substr for ISO-2022-JP on - Form: scan format %+5n %m%d %8f %-30S %b - PetnameFile: nickname file ~/.im/Petname - Address: your mail addresses kazu@mew.org, kazu@wide.ad.jp - AddrRegex: regexp of your addresses ^kazu@.*$ - if necessary - -=head1 SCAN FORMAT - - '%{width}{header-type}' format is available. You can define any - header-type as you want. Default valid header-types are - - %n message number - %d raw Date: field - %f MIME decoded From: field - %t MIME decoded To: filed - %g raw Newsgroups: field - %a friendly From: field - %A If this message is originated by yourself, friendly To: - or raw Newsgroups: is displayed in 'To:xxx' or 'Ng:xxx' - format, respectively. Otherwise, friendly From: field is - displayed. - %P Similar to %A, but diplay raw address of mail sender - instead of friendly From: field, just like mh-e. - %i indent to display thread - %s MIME decoded Subject: field - %S indented MIME decoded Subject (same as %i+%s) - %b a part of body extracted with heuristic - %m Multipart type - 'S'igned, 'E'ncrypt, 'M'ultipart, 'P'artial or none - %p mark '*' if the message is destined to you - %D mark 'D' if the message is duplicated - %M %p+%D - %F folder path -# %B file size - %K file block size (1024 bytes/block) - - %y year - %c month (digit) - %C month (string) - %e mday - %h hour - %E min - %G sec - - {width} is a integer with/without '-' sign. if a '-' sign exists, content - of a header-type will be displaied with left adjustment. If the integer - have leading '0', the field will be padded with leading '0's. - - To improve processing speed, needless process on JIS character should be - avoided. Even if 'JisSafe' is on, only %f, %t, %A, %s, %S and %b are - processed with 'substr' routine for JIS characters by default. If you want - to process other header-types with JIS version of 'substr', specify '!' - just after '%' like: %!-8S. - - ScanForm "%+5n %m%d %-14A %-18S %b" works as same as IM default scaning. - -=head1 PETNAMES FORMAT - - Following format is valid in petnames file. - A line beginning with '#' is ignored. - # This is comments - Kazu@Mew.org "Mr.Kazu" - nom@Mew.org "Nomsun" - -=cut use vars qw($WIDTH $JIS_SAFE $HEADLINELIMIT $BODYLINELIMIT $MSTR2NUM @MSTR @WSTR %symbol_table %multipart_mark @NEEDSAFE %NEEDSAFE_HASH @@ -188,8 +97,8 @@ BEGIN { 'sig' => 'S', ); - @NEEDSAFE = qw (from: to: cc: address: Address: - subject: indent-subject: body: ); + @NEEDSAFE = qw(from: to: cc: address: Address: + subject: indent-subject: body:); %NEEDSAFE_HASH = (); @@ -203,8 +112,8 @@ BEGIN { ## If user specifies a scan format, convert that to 'eval-form'. ## -sub set_scan_form ($$$) { - my ($scan_form, $width, $jis_safe) = @_; +sub set_scan_form($$$) { + my($scan_form, $width, $jis_safe) = @_; $ALLOW_CRLF = allowcrlf(); @@ -233,7 +142,7 @@ sub set_scan_form ($$$) { ## get_header ## -sub get_header ($) { +sub get_header($) { my $path = shift; my %Head = (); my $folder; @@ -301,8 +210,8 @@ foreach (@STRUCTURED) { $STRUCTURED_HASH{$_} = 1; } -sub store_header ($$) { - my ($href, $header) = @_; +sub store_header($$) { + my($href, $header) = @_; local $_; my $lines = 0; @@ -334,10 +243,10 @@ sub store_header ($$) { # mode: 1 if HANDLER is File Handler, otherwise HANDLER is Array # return value: substring from body # -sub parse_body (*$) { +sub parse_body(*$) { local *HANDLE = shift; my $mode = shift; - my ($content, $lines) = ('', 0); + my($content, $lines) = ('', 0); while (1) { if ($mode == 0) { @@ -351,7 +260,7 @@ sub parse_body (*$) { next if /^\s*\n/; next if /^--/; next if /^- --/; - next if /^\s+[\w-*]+=/; # eg. "boundary="; * = RFC2231 + next if /^\s+[\w*-]+=/; # eg. "boundary="; * = RFC2231 next if /^\s*[\w-]+: /; # Headers and header style citation next if /^\s*[\w-]*[>|]/; # other citation next if /:\n$/; @@ -385,7 +294,7 @@ sub parse_body (*$) { return substr_safe($content, $WIDTH); } -sub parse_header ($) { +sub parse_header($) { my $href = shift; ## @@ -409,10 +318,10 @@ sub parse_header ($) { if ($href->{'date'}) { $href->{'date:'} = $href->{'date'}; } else { - my ($sec, $min, $hour, $mday, $mon, $year, - $wday, $yday, $isdst) = localtime((stat($href->{'path'}))[9]); - my ($gsec, $gmin, $ghour, $gmday, $gmon, $gyear, - $gwday, $gyday, $gisdst) = gmtime((stat($href->{'path'}))[9]); + my($sec, $min, $hour, $mday, $mon, $year, + $wday, $yday, $isdst) = localtime((stat($href->{'path'}))[9]); + my($gsec, $gmin, $ghour, $gmday, $gmon, $gyear, + $gwday, $gyday, $gisdst) = gmtime((stat($href->{'path'}))[9]); my $off = ($hour - $ghour) * 60 + $min - $gmin; if ($year < $gyear) { @@ -439,11 +348,11 @@ sub parse_header ($) { } $href->{'date:'} =~ /(\d\d?)\s+([A-Za-z]+)\s+(\d+)\s/; - my ($mday, $monthstr, $year) = ($1, "\u\L$2", $3); + my($mday, $monthstr, $year) = ($1, "\u\L$2", $3); my $mon = $MSTR2NUM->{$monthstr}; $href->{'date:'} =~ /\s(\d\d?):(\d\d?)/; - my ($hour, $min, $sec) = ($1, $2, 0); + my($hour, $min, $sec) = ($1, $2, 0); if ($href->{'date:'} =~ /\s\d\d?:\d\d?:(\d\d?)\s/) { $sec = $1; } @@ -510,7 +419,7 @@ sub parse_header ($) { if ($REF_SYMBOL{'pureaddr:'}) { if (my_addr($href->{'from'})) { if ($href->{'to'}) { - my ($to, $rest) = &fetch_addr($href->{'to'}, 1); + my($to, $rest) = &fetch_addr($href->{'to'}, 1); if ($to) { $href->{'pureaddr:'} = 'To:' . $to; } @@ -552,8 +461,8 @@ sub parse_header ($) { &scan_sub($href) if (defined(&scan_sub)); } -sub disp_msg ($;$) { - my ($href, $vscan) = @_; +sub disp_msg($;$) { + my($href, $vscan) = @_; $href->{'indent:'} = '' unless defined($href->{'indent:'}); $href->{'subject:'} = '' unless defined($href->{'subject:'}); @@ -586,11 +495,11 @@ sub disp_msg ($;$) { ## Convert into Friendly Address ## -sub friendly_addr ($$) { - my ($addr, $need_addr) = @_; +sub friendly_addr($$) { + my($addr, $need_addr) = @_; return '' unless $addr; my $friendly = ''; - my ($a, $f, $p); + my($a, $f, $p); while (($a, $addr, $f) = &fetch_addr($addr, 1), $a ne '') { $a =~ s/\/[^@]*//; if (defined(%petnames) && $petnames{lc($a)}) { @@ -616,14 +525,14 @@ sub friendly_addr ($$) { %ADDRESS_HASH = (); -sub my_addr (@) { +sub my_addr(@) { my @addrs = @_; my $addr; unless (defined($ADDRESS_HASH{'init'})) { $ADDRESS_HASH{'addr'} = addresses_regex(); unless ($ADDRESS_HASH{'addr'}) { - $ADDRESS_HASH{'addr'} = '^' . quotemeta(address()) . '$'; + $ADDRESS_HASH{'addr'} = '^' . quotemeta(address()) . '$'; #' $ADDRESS_HASH{'addr'} =~ s/(\\\s)*\\,(\\\s)*/\$|\^/g; } $ADDRESS_HASH{'init'} = 1; @@ -643,7 +552,7 @@ sub my_addr (@) { ## Convert scan_form() to 'eval-form' ## -sub convert_scan_form ($) { +sub convert_scan_form($) { my $SCANFORM = shift; if (!$main::INSECURE && $SCANFORM && $SCANFORM !~ /%/) { @@ -652,7 +561,7 @@ sub convert_scan_form ($) { } my @symbols = (); - my ($format, $jis_safe, $plus, $hyphen, $size, $type, $arg); + my($format, $jis_safe, $plus, $hyphen, $size, $type, $arg); if (scan_header_pick()) { my $elem; @@ -714,7 +623,7 @@ sub convert_scan_form ($) { $arg = join(',', @symbols); my $EVAL_SCAN_FORM = "sprintf('$format', $arg)"; - eval "sub scan_form { my (\$href) = shift; $EVAL_SCAN_FORM }"; + eval "sub scan_form { my(\$href) = shift; $EVAL_SCAN_FORM }"; if ($@) { im_die("Form seems to be wrong.\nPerl error message is: $@"); } @@ -734,7 +643,7 @@ BEGIN { $SS3 = "\x1b\x4f"; # <ISO 2022 Single_shift three> } -sub substr_safe ($$) { +sub substr_safe($$) { ($_, my $len) = @_; # This hack makes the code a few percent faster but it's kinda ugly. @@ -864,20 +773,19 @@ sub substr_safe ($$) { ## Read petnames entry ## -sub w2n ($) { +sub w2n($) { my $line = shift; $line =~ tr/\x20/\x0/; return $line; } -sub read_petnames () { - +sub read_petnames() { if (addrbook_file() && open(ADDRBOOK, addrbook_file())) { my $key; my $addr; my $petname; my $a; my @addrs; my $code; - while(<ADDRBOOK>) { + while (<ADDRBOOK>) { my $line = ''; do { chomp; @@ -893,7 +801,7 @@ sub read_petnames () { $line .= $_; } while (/[,\\]$/ && defined($_ = <ADDRBOOK>)); $_ = $line; - s/"([^"]+)"/w2n($1)/geo; + s/"([^"]+)"/w2n($1)/geo; #" s/,\s+/,/g; if (s/^(\S+)\s+(\S+)\s+(\S+)//) { $key = $1; @@ -921,11 +829,11 @@ sub read_petnames () { im_warn("can't open petname file $file\n"); return; } - while(<PETNAMES>) { + while (<PETNAMES>) { next if (/^$/); next if (/^#/); chomp; - my ($name, $petname); + my($name, $petname); if (/(\S+)\s+(.*)/) { $name = $1; $petname = $2; @@ -938,6 +846,111 @@ sub read_petnames () { 1; +__END__ + +=head1 NAME + +IM::Scan - scan listing from mail/news message + +=head1 SYNOPSIS + + use IM::Scan; + + &set_scan_form($scan_form, $width, $use_jis); + &read_petnames(); + %Head = &get_header($mail_file); + &disp_msg(\%Head); + +=head1 DESCRIPTION + +The I<IM::Scan> module handles scan format and petnames format +for mail/news message. + +This modules is provided by IM (Internet Message). + +=head1 FILES + + $HOME/.im/Config the user profile + +=head1 PROFILE COMPONENTS + + Component Explanation Example + + MailDir: your mail directory Mail + Width: one line width 80 + JisSafe: safely substr for ISO-2022-JP on + Form: scan format %+5n %m%d %8f %-30S %b + PetnameFile: nickname file ~/.im/Petname + Address: your mail addresses kazu@mew.org, kazu@wide.ad.jp + AddrRegex: regexp of your addresses ^kazu@.*$ + if necessary + +=head1 SCAN FORMAT + +'%{width}{header-type}' format is available. You can define any +header-type as you want. Default valid header-types are + + %n message number + %d raw Date: field + %f MIME decoded From: field + %t MIME decoded To: filed + %g raw Newsgroups: field + %a friendly From: field + %A If this message is originated by yourself, friendly To: + or raw Newsgroups: is displayed in 'To:xxx' or 'Ng:xxx' + format, respectively. Otherwise, friendly From: field is + displayed. + %P Similar to %A, but diplay raw address of mail sender + instead of friendly From: field, just like mh-e. + %i indent to display thread + %s MIME decoded Subject: field + %S indented MIME decoded Subject (same as %i+%s) + %b a part of body extracted with heuristic + %m Multipart type + 'S'igned, 'E'ncrypt, 'M'ultipart, 'P'artial or none + %p mark '*' if the message is destined to you + %D mark 'D' if the message is duplicated + %M %p+%D + %F folder path + %K file block size (1024 bytes/block) + + %y year + %c month (digit) + %C month (string) + %e mday + %h hour + %E min + %G sec + +{width} is a integer with/without '-' sign. if a '-' sign exists, content +of a header-type will be displaied with left adjustment. If the integer +have leading '0', the field will be padded with leading '0's. + +To improve processing speed, needless process on JIS character should be +avoided. Even if 'JisSafe' is on, only %f, %t, %A, %s, %S and %b are +processed with 'substr' routine for JIS characters by default. If you want +to process other header-types with JIS version of 'substr', specify '!' +just after '%' like: %!-8S. + +ScanForm "%+5n %m%d %-14A %-18S %b" works as same as IM default scaning. + +=head1 PETNAMES FORMAT + +Following format is valid in petnames file. +A line beginning with '#' is ignored. + + # This is comments + Kazu@Mew.org "Mr.Kazu" + nom@Mew.org "Nomsun" + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Smtp.pm b/img/lib/IM/Smtp.pm index b913a2e4..af730a06 100644 --- a/img/lib/IM/Smtp.pm +++ b/img/lib/IM/Smtp.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Smtp.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Smtp.pm version 20021207(IM142)"; package IM::Smtp; require 5.003; @@ -28,21 +28,6 @@ use vars qw(@ISA @EXPORT); @EXPORT = qw(smtp_open smtp_close smtp_transaction smtp_transaction_for_error_notify); -=head1 NAME - -Smtp - SMTP interface package - -=head1 SYNOPSIS - -$return_code = &smtp_open(current_server, server_list, log_flag); -$return_code = &smtp_close(socket, savehist_flag); -$return_code = &smtp_transaction(bcc_flag, part_current, part_total); -$return_code = &smtp_transaction_for_error_notify; - -=head1 DESCRIPTION - -=cut - use vars qw(@Status $Smtp_opened *SMTPd $SmtpErrTitle $Esmtp_flag %ESMTP); ##### SMTP SESSION OPENING ##### @@ -56,8 +41,8 @@ use vars qw(@Status $Smtp_opened *SMTPd $SmtpErrTitle # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub smtp_open ($$$) { - my ($server, $server_list, $logging) = @_; +sub smtp_open($$$) { + my($server, $server_list, $logging) = @_; local $_; my $rc; my $svr = &get_cur_server_original_form(); @@ -77,7 +62,7 @@ sub smtp_open ($$$) { $SmtpErrTitle = "(while talking to " . &get_cur_server() . " with smtp)\n"; return $rc if ($rc = &tcp_command(\*SMTPd, '', '')); $Esmtp_flag = 0; - my (@resp) = &command_response; + my(@resp) = &command_response; if (join('/', @resp) =~ /ESMTP/) { $Esmtp_flag = 1; } @@ -85,7 +70,7 @@ sub smtp_open ($$$) { if ($Esmtp_flag) { unless (&tcp_command(\*SMTPd, "EHLO $main::Client_name", '')) { # ESMTP OK - my (@resp) = &command_response; + my(@resp) = &command_response; foreach (@resp) { if (/^250[ \-]([A-Z0-9]+)$/) { $ESMTP{$1} = 1; @@ -114,7 +99,7 @@ sub smtp_open ($$$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub smtp_close () { +sub smtp_close() { # @Status =(); return 0 unless ($SMTPd); return 0 unless ($Smtp_opened); @@ -137,8 +122,8 @@ sub smtp_close () { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub smtp_transaction ($$$$$$) { - my ($servers, $Header, $Body, $bcc, $part, $total) = @_; +sub smtp_transaction($$$$$$) { + my($servers, $Header, $Body, $bcc, $part, $total) = @_; my $rc; my $fatal_error = 0; @@ -181,9 +166,9 @@ sub smtp_transaction ($$$$$$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub smtp_transact_sub ($$$$$$$) { - my ($server, $server_list, $Header, $Body, $bcc, $part, $total) = @_; - my ($i, $rc, $fail, @fatal, $msg_size, $btype); +sub smtp_transact_sub($$$$$$$) { + my($server, $server_list, $Header, $Body, $bcc, $part, $total) = @_; + my($i, $rc, $fail, @fatal, $msg_size, $btype); return $rc if ($rc = smtp_open($server, $server_list, 1)); if ($ESMTP{'8BITMIME'} && $main::Has_8bit_body && !$main::do_conv_8to7) { $btype = ' BODY=8BIT'; @@ -199,7 +184,7 @@ sub smtp_transact_sub ($$$$$$$) { } return $rc if ($rc); $fail = 0; - my ($rec); + my($rec); for ($i = 0; $i <= $#main::Recipients; $i++) { $rec = $main::Recipients[$i]; if ($bcc) { @@ -210,7 +195,7 @@ sub smtp_transact_sub ($$$$$$$) { } else { $rc = &tcp_command(\*SMTPd, "RCPT TO:<$rec>", ''); } - my (@resp) = &command_response; + my(@resp) = &command_response; if ($rc) { push(@fatal, @resp); } @@ -223,7 +208,7 @@ sub smtp_transact_sub ($$$$$$$) { } else { $rc = &tcp_command(\*SMTPd, "RCPT TO:$rec", ''); } - my (@resp) = &command_response; + my(@resp) = &command_response; if ($rc) { push(@fatal, @resp); } @@ -252,7 +237,7 @@ sub smtp_transact_sub ($$$$$$$) { } select (SMTPd); $| = 1; select (STDOUT); return $rc if ($rc = &tcp_command(\*SMTPd, '.', '')); - my (@resp) = &command_response; + my(@resp) = &command_response; &log_action($Esmtp_flag ? 'esmtp' : 'smtp', &get_cur_server(), join(',', @main::Recipients), 'sent', @resp); $main::Info .= "Delivery successful for the following recipient(s):\n"; @@ -276,9 +261,9 @@ sub smtp_transact_sub ($$$$$$$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub smtp_transaction_for_error_notify ($$$$) { - my ($server, $servers, $Header, $Body) = @_; - my ($rc, @prev_rcpt, @prev_stat); +sub smtp_transaction_for_error_notify($$$$) { + my($server, $servers, $Header, $Body) = @_; + my($rc, @prev_rcpt, @prev_stat); @prev_rcpt = @main::Recipients; @prev_stat = @Status; @main::Recipients = ($main::Sender); @@ -292,7 +277,7 @@ sub smtp_transaction_for_error_notify ($$$$) { $Esmtp_flag ? 'esmtp' : 'smtp', &get_cur_server, 1, &get_session_log); select (SMTPd); $| = 1; select (STDOUT); return $rc if ($rc = &tcp_command(\*SMTPd, '.', '')); - my (@resp) = &command_response; + my(@resp) = &command_response; &log_action($Esmtp_flag ? 'esmtp' : 'smtp', &get_cur_server(), join(',', @main::Recipients), 'sent', @resp); return 0; @@ -300,6 +285,35 @@ sub smtp_transaction_for_error_notify ($$$$) { 1; +__END__ + +=head1 NAME + +IM::Smtp - SMTP handler + +=head1 SYNOPSIS + + use IM::Smtp; + + $return_code = &smtp_open(current_server, server_list, log_flag); + $return_code = &smtp_close(socket, savehist_flag); + $return_code = &smtp_transaction(bcc_flag, part_current, part_total); + $return_code = &smtp_transaction_for_error_notify; + +=head1 DESCRIPTION + +The I<IM::Smtp> module handles SMTP. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Ssh.pm b/img/lib/IM/Ssh.pm index bcac3f39..404a8f78 100644 --- a/img/lib/IM/Ssh.pm +++ b/img/lib/IM/Ssh.pm @@ -4,46 +4,47 @@ ### Ssh.pm ### ### Author: Masatoshi Tsuchiya <tsuchiya@pine.kuee.kyoto-u.ac.jp> +### Internet Message Group <img@mew.org> ### Created: Oct 05, 1999 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Ssh.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Ssh.pm version 20021207(IM142)"; package IM::Ssh; require 5.003; require Exporter; -use IM::Config qw( connect_timeout command_timeout $SSH_PATH ); +use IM::Config qw(connect_timeout command_timeout $SSH_PATH); use IM::Util; use strict; -use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $SSH $FH @PID ); -@ISA = qw( Exporter ); -@EXPORT = qw( ssh_proxy ); +use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $SSH $FH @PID); +@ISA = qw(Exporter); +@EXPORT = qw(ssh_proxy); # Global Variables $FH = "SSH00000"; @PID = (); -sub ssh_proxy ($$$$) { - my( $server, $remote, $local, $host ) = @_; +sub ssh_proxy($$$$) { + my($server, $remote, $local, $host) = @_; - unless( $host ){ - im_err( "Missing relay host.\n" ); + unless ($host) { + im_err("Missing relay host.\n"); return 0; } - im_notice( "openning SSH-tunnel to $server/$remote\%$local via $host\n" ) + im_notice("openning SSH-tunnel to $server/$remote\%$local via $host\n") if &verbose; - my( $pid, $read, $write ); + my($pid, $read, $write); FORK: { no strict 'refs'; $read = $FH++; $write = $FH++; - pipe( $read, $write ); - if ( $pid = fork ) { + pipe($read, $write); + if ($pid = fork) { close $write; - my( $buf, $sig, $i ); - for( $i=0; $i<3; $i++ ){ + my($buf, $sig, $i); + for ($i=0; $i<3; $i++) { $sig = $SIG{ALRM}; $SIG{ALRM} = sub { die "SIGALRM is received\n"; }; eval { @@ -52,34 +53,35 @@ sub ssh_proxy ($$$$) { alarm 0; }; $SIG{ALRM} = $sig; - if ( $@ !~ /SIGALRM is received/ ) { - push( @PID, $pid ); - if ( $buf =~ /ssh_proxy_connect/ ) { + if ($@ !~ /SIGALRM is received/) { + push(@PID, $pid); + if ($buf =~ /ssh_proxy_connect/) { return $local; - } elsif ( $buf =~ /Local: bind: Address already in use/ ) { + } elsif ($buf =~ /Local: bind: Address already in use/) { $local++; redo FORK; - } elsif( $buf ){ + } elsif ($buf) { last; } } } $buf =~ s/\s+$//; $buf =~ s/\n/\\n/g; - im_warn( "Accident in Port Forwading: $buf\n" ); - } elsif ( $pid == 0 ) { + im_warn("Accident in Port Forwading: $buf\n"); + } elsif ($pid == 0) { close $read; - open(STDOUT, ">&$write" ); - open(STDERR, ">&$write" ); + open(STDOUT, ">&$write"); + open(STDERR, ">&$write"); exec($SSH_PATH, '-n', '-x', '-o', 'BatchMode yes', - "-L$local:$server:$remote", $host, - sprintf( 'echo ssh_proxy_connect ; sleep %s', &command_timeout() ) ); + "-L$local:$server:$remote", $host, + sprintf('echo ssh_proxy_connect ; sleep %s', + &command_timeout())); exit 0; # Not reach. - } elsif ( $! =~ /No more process/ ) { + } elsif ($! =~ /No more process/) { sleep 5; redo FORK; } else { - im_warn( "Can't fork $SSH_PATH.\n" ); + im_warn("Can't fork $SSH_PATH.\n"); } } 0; @@ -87,12 +89,69 @@ sub ssh_proxy ($$$$) { sub END { - if ( @PID ) { + if (@PID) { kill 15, @PID; sleep 3; kill 9, @PID; } } - 1; + +__END__ + +=head1 NAME + +IM::Ssh - SSH handler + +=head1 SYNOPSIS + + use IM::Ssh; + + if ($remote = ssh_proxy($server, $remote, $local, $host)) { + # connection succeeded + } else { + # connection failed + } + +=head1 DESCRIPTION + +The I<IM::Ssh> module handles SSH. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + +### Copyright (C) 1997, 1998, 1999 IM developing team +### 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 team 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 TEAM 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 TEAM 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. diff --git a/img/lib/IM/Stdio.pm b/img/lib/IM/Stdio.pm index c247e6b1..7d4d9808 100644 --- a/img/lib/IM/Stdio.pm +++ b/img/lib/IM/Stdio.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: May 7, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Stdio.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Stdio.pm version 20021207(IM142)"; package IM::Stdio; require 5.003; @@ -22,7 +22,7 @@ use vars qw(@ISA @EXPORT $old); # why not my($old)? @ISA = qw(Exporter); @EXPORT = qw(flush); -sub flush (*) { +sub flush(*) { local($old) = select(shift); $| = 1; print ''; @@ -32,6 +32,37 @@ sub flush (*) { 1; +__END__ + +=head1 NAME + +IM::Stdio - stdio handler + +=head1 SYNOPSIS + + use IM::Stdio; + + flush(OUTPUT_HANDLE); + +=head1 DESCRIPTION + +The I<IM::Stdio> module handles stdio. + +This modules is provided by IM (Internet Message). + +=head1 BUGS + +This module is semi-obsolete. This module conflicts with the +I<IM::Util> module. + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/TcpTransaction.pm b/img/lib/IM/TcpTransaction.pm index 389d47c6..63d6599c 100644 --- a/img/lib/IM/TcpTransaction.pm +++ b/img/lib/IM/TcpTransaction.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::TcpTransaction.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::TcpTransaction.pm version 20021207(IM142)"; package IM::TcpTransaction; require 5.003; @@ -31,21 +31,6 @@ use vars qw(@ISA @EXPORT); get_session_log set_cur_server get_cur_server get_cur_server_original_form pool_priv_sock); -=head1 NAME - -TcpTransaction - TCP Transaction processing interface for SMTP and NNTP - -=head1 SYNOPSIS - -$socket = &connect_server(server_list, protocol, log_flag); -$return_code = &tcp_command(socket, command_string, log_flag); -@response = &command_response; -&set_command_response(response_string_list); - -=head1 DESCRIPTION - -=cut - use vars qw($Cur_server $Cur_server_original_form $Session_log $TcpSockName $SOCK @Response $Logging @SockPool @Sock6Pool); BEGIN { @@ -54,7 +39,7 @@ BEGIN { $TcpSockName = 'tcp00'; } -sub log_transaction () { +sub log_transaction() { use IM::Log; } @@ -66,8 +51,8 @@ sub log_transaction () { # root: privilidge port required # return value: handle if success # -sub connect_server ($$$) { - my ($servers, $serv, $root) = @_; +sub connect_server($$$) { + my($servers, $serv, $root) = @_; if ($#$servers < 0) { im_err("no server specified for $serv\n"); @@ -77,14 +62,14 @@ sub connect_server ($$$) { $SIG{'ALRM'} = \&alarm_func; no strict 'refs'; # XXX - local (*SOCK) = \*{$TcpSockName}; + local(*SOCK) = \*{$TcpSockName}; $SOCK = $serv; @Response = (); - my (@he_infos); - my ($s, $localport, $remoteport); + my(@he_infos); + my($s, $localport, $remoteport); foreach $s (@$servers) { $Cur_server_original_form = $s; - my ($r) = ($#$servers >= 0) ? 'skipped' : 'failed'; + my($r) = ($#$servers >= 0) ? 'skipped' : 'failed'; # manage server[/remoteport]%localport if ($s =~ s/\%(\d+)$//) { $localport = $1; @@ -95,14 +80,14 @@ sub connect_server ($$$) { next unless ($remoteport = getserv($serv, 'tcp')); } if ($main::SSH_server eq 'localhost') { - im_warn( "Don't use port-forwarding to `localhost'.\n" ); + im_warn("Don't use port-forwarding to `localhost'.\n"); $Cur_server = "$s/$remoteport"; } else { - if ( $remoteport = &ssh_proxy($s,$remoteport,$localport,$main::SSH_server) ) { + if ($remoteport = &ssh_proxy($s,$remoteport,$localport,$main::SSH_server)) { $s = 'localhost'; $Cur_server = "$Cur_server%$remoteport"; } else { # Connection failed. - im_warn( "Can't login to $main::SSH_server\n" ); + im_warn("Can't login to $main::SSH_server\n"); if ($serv eq 'smtp') { &log_action($serv, $Cur_server, join(',', @main::Recipients), $r, @Response); @@ -138,7 +123,7 @@ sub connect_server ($$$) { next; } while ($#he_infos >= 0) { - my ($family, $socktype, $proto, $sin, $canonname) + my($family, $socktype, $proto, $sin, $canonname) = splice(@he_infos, 0, 5); if ($root && unixp()) { my $name = priv_sock($family); @@ -207,9 +192,9 @@ sub connect_server ($$$) { # 1: recoverable error (should be retried) # -1: unrecoverable error # -sub tcp_command ($$$) { - my ($CHAN, $command, $fake) = @_; - my ($resp, $stat, $rcode, $logcmd); +sub tcp_command($$$) { + my($CHAN, $command, $fake) = @_; + my($resp, $stat, $rcode, $logcmd); @Response = (); $stat = ''; @@ -266,9 +251,9 @@ sub tcp_command ($$$) { # send_command(channel, command, fake_message) # return value: the first line of responses # -sub send_command ($$$) { - my ($CHAN, $command, $fake) = @_; - my ($resp, $logcmd); +sub send_command($$$) { + my($CHAN, $command, $fake) = @_; + my($resp, $logcmd); if ($command) { print $CHAN "$command\r\n"; if ($fake) { @@ -299,9 +284,9 @@ sub send_command ($$$) { return $resp; } -sub send_data ($$$) { - my ($CHAN, $data, $fake) = @_; - my ($logdata); +sub send_data($$$) { + my($CHAN, $data, $fake) = @_; + my($logdata); $data =~ s/\r?\n?$//; print $CHAN "$data\r\n"; if ($fake) { @@ -313,7 +298,7 @@ sub send_data ($$$) { $Session_log .= "<<< $logdata\n" if ($Logging); } -sub next_response ($) { +sub next_response($) { my $CHAN = shift; my $resp; @@ -334,36 +319,36 @@ sub next_response ($) { return $resp; } -sub command_response () { +sub command_response() { return @Response; } -sub set_command_response (@) { +sub set_command_response(@) { @Response = @_; } -sub tcp_logging ($) { +sub tcp_logging($) { # conversations are saved in $Session_log if true $Logging = shift; } -sub get_session_log () { +sub get_session_log() { return $Session_log; } -sub set_cur_server ($) { +sub set_cur_server($) { $Cur_server = shift; } -sub get_cur_server () { +sub get_cur_server() { return $Cur_server; } -sub get_cur_server_original_form () { +sub get_cur_server_original_form() { return $Cur_server_original_form; } -sub pool_priv_sock ($) { +sub pool_priv_sock($) { my $count = shift; pool_priv_sock_af($count, AF_INET); @@ -373,12 +358,12 @@ sub pool_priv_sock ($) { } } -sub pool_priv_sock_af ($$) { - my ($count, $family) = @_; +sub pool_priv_sock_af($$) { + my($count, $family) = @_; my $privport = 1023; no strict 'refs'; # XXX - my ($pe_name, $pe_aliases, $pe_proto); + my($pe_name, $pe_aliases, $pe_proto); ($pe_name, $pe_aliases, $pe_proto) = getprotobyname ('tcp'); unless ($pe_name) { $pe_proto = 6; @@ -389,7 +374,7 @@ sub pool_priv_sock_af ($$) { return -1; } while ($privport > 0) { - my ($ANYADDR, $psin); + my($ANYADDR, $psin); im_debug("binding port $privport.\n") if (&debug('tcp')); if ($family == AF_INET) { @@ -419,9 +404,9 @@ sub pool_priv_sock_af ($$) { return 0; } -sub priv_sock ($) { - my ($family) = shift; - my ($sock_name); +sub priv_sock($) { + my($family) = shift; + my($sock_name); if ($family == AF_INET) { return '' if ($#SockPool < 0); @@ -438,12 +423,12 @@ sub alarm_func { im_die("connection error\n"); } -sub im_getaddrinfo ($$;$$$$) { +sub im_getaddrinfo($$;$$$$) { return getaddrinfo(@_) if (defined &getaddrinfo); - my ($node, $serv, $family, $socktype, $proto, $flags) = @_; + my($node, $serv, $family, $socktype, $proto, $flags) = @_; - my ($pe_name, $pe_aliases, $pe_proto, $se_port); + my($pe_name, $pe_aliases, $pe_proto, $se_port); if (unixp()) { $proto = 'tcp' unless ($proto); ($pe_name, $pe_aliases, $pe_proto) = getprotobyname($proto); @@ -451,7 +436,7 @@ sub im_getaddrinfo ($$;$$$$) { $pe_proto = 6 unless ($pe_name); return unless ($se_port = getserv($serv, $proto)); - my ($he_name, $he_alias, $he_type, $he_len, @he_addrs); + my($he_name, $he_alias, $he_type, $he_len, @he_addrs); if ($node =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { @he_addrs = (pack('C4', $1, $2, $3, $4)); } else { @@ -462,7 +447,7 @@ sub im_getaddrinfo ($$;$$$$) { return unless ($he_name); } - my ($he_addr, @infos); + my($he_addr, @infos); foreach $he_addr (@he_addrs) { push(@infos, AF_INET, $socktype, $pe_proto, pack_sockaddr_in($se_port, $he_addr), $he_name); @@ -471,13 +456,13 @@ sub im_getaddrinfo ($$;$$$$) { } sub getserv($$) { - my ($serv, $proto) = @_; + my($serv, $proto) = @_; - my ($se_port); + my($se_port); if ($serv =~ /^\d+$/o) { $se_port = $serv; } else { - my ($se_name, $se_aliases); + my($se_name, $se_aliases); ($se_name, $se_aliases, $se_port) = getservbyname($serv, $proto) if (unixp()); unless ($se_name) { @@ -502,6 +487,35 @@ sub getserv($$) { 1; +__END__ + +=head1 NAME + +IM::TcpTransaction - TCP transaction processing interface for SMTP and NNTP + +=head1 SYNOPSIS + + use IM::TcpTransaction; + + $socket = &connect_server(server_list, protocol, log_flag); + $return_code = &tcp_command(socket, command_string, log_flag); + @response = &command_response; + &set_command_response(response_string_list); + +=head1 DESCRIPTION + +The I<IM::TcpTransaction> module handles TCP transaction for SMTP and NNTP. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### diff --git a/img/lib/IM/Util.pm b/img/lib/IM/Util.pm index 8b9235ff..68da1a5e 100644 --- a/img/lib/IM/Util.pm +++ b/img/lib/IM/Util.pm @@ -5,10 +5,10 @@ ### ### Author: Internet Message Group <img@mew.org> ### Created: Apr 23, 1997 -### Revised: Apr 14, 2000 +### Revised: Dec 7, 2002 ### -my $PM_VERSION = "IM::Util.pm version 20000414(IM141)"; +my $PM_VERSION = "IM::Util.pm version 20021207(IM142)"; package IM::Util; require 5.003; @@ -71,7 +71,7 @@ sub unixp { } sub win95p { - if (($OS eq 'WIN95') || ($OS eq 'WNT') ){ + if (($OS eq 'WIN95') || ($OS eq 'WNT')) { return 1; } else { return 0; @@ -94,14 +94,14 @@ sub os2p { } } -sub progname () { +sub progname() { return $main::Prog; } ### ### get login name ### -sub im_getlogin () { +sub im_getlogin() { if (&unixp()) { my $login = getlogin(); if ($login ne '' && $login ne 'root') { @@ -109,9 +109,9 @@ sub im_getlogin () { } else { return (getpwuid($<))[0] || undef; } - } elsif (&os2p()){ + } elsif (&os2p()) { return getlogin() || undef; - } elsif (&win95p()){ + } elsif (&win95p()) { return Win32::LoginName(); } } @@ -128,54 +128,54 @@ sub im_getlogin () { # im_err - display critical error messages -- process will be aborted # im_die - display critical error messages and exit -sub im_msg ($) { +sub im_msg($) { my $msg = shift; print progname(), ': ', $msg; } -sub im_info ($) { +sub im_info($) { my $info = shift; return if $main::opt_quiet; print progname(), ': ', $info; } -sub im_debug ($) { +sub im_debug($) { my $dbg = shift; print STDERR progname(), ':DEBUG: ', $dbg; } -sub im_notice ($) { +sub im_notice($) { return unless &verbose; my $warn = progname() . ': '. shift; $SavedMsg .= $warn; print STDERR $warn; } -sub im_warn ($) { +sub im_warn($) { my $warn = progname() . ': '. shift; $SavedMsg .= $warn; print STDERR $warn; } -sub im_err ($) { +sub im_err($) { my $err = progname() . ': ERROR: ' . shift; $SavedMsg .= $err; print STDERR $err; } -sub im_die ($) { +sub im_die($) { my $die = shift; print STDERR progname(), ': ERROR: ', $die; exit $EXIT_ERROR; } -sub im_die2 ($) { +sub im_die2($) { my $die = shift; print STDERR progname(), ': ', $die; exit $EXIT_ERROR; } -sub im_save_error (;$) { +sub im_save_error(;$) { my $string = shift; if ($string eq '') { $SavedMsg = ''; # reset @@ -184,7 +184,7 @@ sub im_save_error (;$) { } } -sub im_saved_errors () { +sub im_saved_errors() { return $SavedMsg; } @@ -192,22 +192,21 @@ sub im_saved_errors () { ### Debug ### -sub print_hash (\%) -{ +sub print_hash(\%) { my $hashref = shift; - foreach (keys(%{$hashref})){ + foreach (keys(%{$hashref})) { print "$_ -> $hashref->{$_}\n"; } } -sub set_debug ($$) { +sub set_debug($$) { my $category = shift; $Debug{$category} = shift; } -sub debug ($) { +sub debug($) { my $category = shift; if ($Debug{'all'}) { @@ -217,11 +216,11 @@ sub debug ($) { } } -sub set_verbose ($) { +sub set_verbose($) { $main::opt_verbose = shift; } -sub verbose () { +sub verbose() { return $main::opt_verbose; } @@ -229,7 +228,7 @@ sub verbose () { # # debug_option() # -sub debug_option ($) { +sub debug_option($) { my $DebugFlag = shift; if ($DebugFlag && ($DebugFlag !~ /^(off|no|false|0)$/)) { @@ -245,7 +244,7 @@ sub debug_option ($) { # flush buffer # -sub flush (*) { +sub flush(*) { local($old) = select(shift); $| = 1; print ''; @@ -258,8 +257,8 @@ sub flush (*) { # sub im_open($$) { - my ($d, $a) = @_; - my ($r); + my($d, $a) = @_; + my($r); if ($r = open($d, $a)) { binmode($d); } @@ -267,8 +266,8 @@ sub im_open($$) { } sub im_sysopen($$$) { - my ($d, $f, $a) = @_; - my ($r); + my($d, $f, $a) = @_; + my($r); if ($r = sysopen($d, $f, $a)) { binmode($d); } @@ -277,6 +276,45 @@ sub im_sysopen($$$) { 1; +__END__ + +=head1 NAME + +IM::Util - utility functions for IM + +=head1 SYNOPSIS + + use IM::Util; + +Constant variables: +$SUCCESS +$ERROR +$EXIT_SUCCESS +$EXIT_ERROR + +Subroutines: +unixp win95p wntp os2p +progname +im_getlogin +im_msg im_info im_debug im_notice im_warn im_err im_die im_die2 +im_save_error im_saved_errors im_open im_sysopen +debug_option set_debug debug set_verbose verbose +flush + +=head1 DESCRIPTION + +The I<IM::Util> module provides utility functions for IM. + +This modules is provided by IM (Internet Message). + +=head1 COPYRIGHT + +IM (Internet Message) is copyrighted by IM developing team. +You can redistribute it and/or modify it under the modified BSD +license. See the copyright file for more details. + +=cut + ### Copyright (C) 1997, 1998, 1999 IM developing team ### All rights reserved. ### |