# -*-Perl-*-
################################################################
###
### Config.pm
###
### Author: Internet Message Group
### Created: Apr 23, 1997
### Revised: May 25, 2011
###
my $PM_VERSION = "IM::Config.pm version 20161010(IM153)";
package IM::Config;
require 5.003;
require Exporter;
use IM::Util;
use integer;
use strict 'vars';
use strict 'subs';
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(
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 preferred_fsync_no
addrbook_file aliases_file petname_file mail_folders_file
context_file getchksbr_file getsbr_file scansbr_file scan_header_pick
address addresses_regex
msgdbfile msgdbtype
mbox_style mbox_filter
nntpservers nntphistoryfile nntpauthuser set_nntpauthuser
popaccount pophistoryfile imapaccount smtpaccount httpproxy noproxy
usepwagent pwagentport pwagent_tmp_dir pwagent_tmp_path usepwfiles pwfiles
expand_path use_xdispatcher usetouchfile touchfile
namazuv2 namazu_dir namazu_path namazu_lock_dir namazu_lock_path
mknmz_options mknmz_include_file mknmz_ignore_folders_regex
pop_timeout imap_timeout nntp_timeout dns_timeout
connect_timeout command_timeout rcv_buf_siz
db_type file_attr ssh_path);
##
## Constant
##
use vars qw($CURRENT_DIR $HOME_DIR $IM_SYS_DIR
$IM_USER_DIR $IM_SYS_PROFILE $IM_USER_PROFILE
@CfgConfig %CASES
@O_IORD %O_DESC %O_VNAM %O_FULL %O_ABBR %O_HELP
$O_FOPT %C_DESC %C_VNAM
%WHO_SET
@SELECTORS
$IM_SYSCONFDIR $IM_DB_TYPE $FSYNC_NO
$prefix $exec_prefix $SSH_PATH);
##
## configurable value by configure
##
$prefix="@prefix@";
$exec_prefix= "@exec_prefix@";
$IM_SYSCONFDIR = "@sysconfdir@/im";
$IM_DB_TYPE = '@im_db_type@';
$FSYNC_NO = @im_fsync_no@;
$SSH_PATH = "@im_path_ssh@";
sub file_attr() {
return @im_file_attr@;
}
##
##
$CURRENT_DIR = $ENV{'PWD'} || eval { use Cwd; fastcwd(); } ||
im_die("can't get your current directory\n");
$HOME_DIR = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7] ||
im_die("can't get your home directory\n");
$HOME_DIR =~ s:\\:/:g; # "\home\user" -> "/home/user"
$HOME_DIR =~ s/\/$//; # "/home/" -> "/home"
$IM_SYS_DIR = $ENV{'IM_SYS_DIR'} || "$IM_SYSCONFDIR";
$IM_USER_DIR = &expand_home($ENV{'IM_USER_DIR'} || '.im');
$IM_SYS_PROFILE = "$IM_SYS_DIR/SiteConfig";
$IM_USER_PROFILE = "$IM_USER_DIR/Config";
##
##
##
BEGIN {
@CfgConfig = (
'maildir;s;;MailDir' => 'A directory to contain mail messages',
'newsdir;s;;NewsDir' => 'A directory to contain news messages',
'queuedir;s;;QueueDir' => 'A directory to store messages to be sent',
'inboxfolder;f;;InboxFolder' => 'Inbox folder',
'draftfolder;f;;DraftFolder' => 'Draft folder',
'trashfolder;f;;TrashFolder' => 'Trash folder',
'foldermode;i;;FolderMode' => 'Folder directory mode when created',
'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',
'sshpath;s;;SshPath' => 'Path name of SSH program',
'allowcrlf;b;;AllowCRLF' => 'CRLF may be in saved message',
'preservedot;b;;PreserveDot' => 'Not substitute "." with "/"',
'addrbookfile;s;;AddrBookFile' => 'Address book file',
'aliasesfile;s;;AliasesFile' => 'Aliases file',
'petnamefile;s;;PetNameFile' => 'PetName file',
'petnamefile;s;;PetNameFile' => 'PetName file',
'mailfoldersfile;s;;MailFoldersFile' => 'Mail folders file',
'contextfile;s;Context;ContextFile' => 'Context file',
'address;s;;Address' => 'Email addresses',
'addrregex;s;;AddrRegex' => 'Email addresses by regex',
'msgdbfile;s;;MsgDBFile' => 'Message database location',
'msgdbtype;s;;MsgDBType' => 'Message database type',
'getchksbr;s;;GetChkSbrFile' => 'GetChk hook subroutine script',
'getsbr;s;;GetSbrFile' => 'Get hook subroutine script',
'scansbr;s;;ScanSbrFile' => 'Scan hook subroutine script',
'scanheaderpick;s;;ScanHeaderPick' => 'Scan headers to pick up',
'mboxstyle;s;;MBoxStyle' => 'Style of local mailbox format',
'mboxfilter;s;;MboxFilter' => 'Filter for mbox file',
'nntpservers;s;;NNTPservers' => 'List of NNTP servers',
'nntphistory;s;;NNTPhistory' => 'Status file of NNTP access',
'nntpauthuser;s;;NNTPauthuser' => 'User name for NNTP authentication',
'popaccount;s;;POPaccount' => 'Account info for POP access',
'pophistory;s;;POPhistory' => 'Status file of POP access',
'imapaccount;s;;IMAPaccount' => 'Account info for IMAP access',
'smtpaccount;s;;SMTPaccount' => 'Account info for SMTP authentication',
'httpproxy;s;;HTTPproxy' => 'Proxy server for HTTP access',
'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',
'imaptimeout;i;20;ImapTimeout' => 'Timeout for IMAP connection',
'nntptimeout;i;20;NntpTimeout' => 'Timeout for NNTP connection',
'dnstimeout;i;60;DnsTimeout' => 'Timeout for DNS connection',
'connecttimeout;i;60;ConnectTimeout' => 'Timeout for connection making',
'commandtimeout;i;300;CommandTimeout' => 'Timeout for each command',
'rcvbufsiz;i;;RcvBufSiz' => 'Receive buffer size of TCP',
'usexdispatcher;b;;UseXDispatcher' => 'Use X-Dispatcher field',
'usetouchfile;b;;UseTouchFile' => 'Use touch file',
'touchfile;s;;TouchFile' => 'Touch file name',
'namazuv2;b;;NamazuV2' => 'Use Namazu Version 2 (1.9 or late)',
'namazudir;s;;NamazuDir' => 'A directory to contain Namazu indexes',
'namazulockdir;s;;NamazuLockDir' => 'Lock directory for Namazu',
'mknmzoptions;s;;MknmzOptions' => 'Options for mknmz',
'mknmzincludefile;s;;MknmzIncludeFile' => 'A file for mknmz -I',
'mknmzignorefoldersregex;s;;MknmzIgnoreFoldersRegex' => 'Folders regex ignored by immknmz',
);
# these vars should be in current package?
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); #'
}
}
# print "use vars qw(@vars);\n";
eval "use vars qw(@vars);";
}
##
##
##
sub read_cfg_selector($) {
my $argvref = shift;
my $i = 0;
my $selector = '';
foreach $a (@$argvref) {
if ($a =~ /^--config=(.*)$/i) {
$selector = $1;
## side effect!
## --config=value is removed from @ARGV
splice(@$argvref, $i, 1);
}
$i++;
}
return $selector;
}
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
%O_VNAM = (); # --help -> help
%O_FULL = (); # -h -> --help
%O_ABBR = (); # --help -> -h
%O_HELP = (); # --help -> "help message"
# $O_FOPT; # --src or --dst for help
%C_DESC = (); # address -> s|s@|i|f|f@|b|B
%C_VNAM = (); # address -> Address
# set @CfgConfig
$i = 0;
$N = scalar(@CfgConfig);
while ($i < $N) {
($name, $desc, $dflt, $vnam) = split(';', $CfgConfig[$i]);
$i += 2;
if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B)$/) {
$optn = $name;
if ($vnam) {
# no main:: !
$C_VNAM{$optn} = $vnam;
} else {
$C_VNAM{$optn} = "main::opt_\L$name";
}
$C_DESC{$optn} = $desc;
${$C_VNAM{$optn}} = $dflt if $dflt;
} else {
im_warn("invalid opt desc ``$desc'' for $optn\n");
return undef;
}
}
# set @OptConfig
$i = 0;
$N = scalar(@$optref);
while ($i < $N) {
($name, $desc, $dflt, $vnam) = split(';', $$optref[$i]);
$i++;
$help = $$optref[$i];
$i++;
if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B|d)$/) {
my $abbr;
if ($name =~ ',') {
($name, $abbr) = split(',', $name);
$abbr = "-$abbr";
}
$optn = lc("--$name");
push(@O_IORD, $optn);
if ($vnam) {
$O_VNAM{$optn} = "main::$vnam";
} else {
$O_VNAM{$optn} = "main::opt_\L$name";
}
${$O_VNAM{$optn}} = $dflt if $dflt;
$O_DESC{$optn} = $desc;
$O_HELP{$optn} = $help;
unless ($cptref || $desc eq 'd') {
# no @CptConfig, so set abbrev
$abbr = substr($optn, 1, 2) unless $abbr; # -h
$O_FULL{$abbr} = $optn;
$O_ABBR{$optn} = $abbr;
}
$O_FOPT = $optn if $desc =~ /^F/;
} else {
im_warn("invalid opt desc ``$desc'' for $optn\n\n");
return undef;
}
}
# set @CptConfig
if ($cptref) {
$i = 0;
$N = scalar(@$cptref);
while ($i < $N) {
($name, $desc, $dflt, $vnam) = split(';', $cptref->[$i]);
$i++;
$help = $cptref->[$i];
$i++;
if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B)$/) {
$optn = "-$name"; ## no lc()
push(@O_IORD, $optn);
if ($vnam) {
$O_VNAM{$optn} = "main::$vnam";
} else {
$O_VNAM{$optn} = "main::opt_\L$name";
}
# $dflt should be "off" if /b/ and "on" if /B/ usually
# but no such limitations here to allow -opt and -noopt pair.
${$O_VNAM{$optn}} = $dflt if $dflt;
$O_DESC{$optn} = $desc;
$O_HELP{$optn} = $help;
} else {
im_warn("invalid opt desc ``$desc'' for $optn\n\n");
return undef;
}
}
}
return 1;
}
sub read_env($) {
my $envref = shift;
my($i, $N) = (0, scalar(@$envref));
my($name, $desc, $dflt, $var);
while ($i < $N) {
($name, $desc, $dflt, $var) = split(';', $envref->[$i]);
if ($ENV{$name}) {
set_value($desc, $var, $ENV{$name}, 'env');
} elsif ($dflt) { # not else !
set_value($desc, $var, $dflt, 'env');
}
$i++;
}
}
sub read_cfg() {
my($profile, @profiles);
my $prev_line = '';
my $case;
my $use;
my @USECASES;
my @prog_cfg;
@profiles = ('', $IM_SYS_PROFILE, $IM_USER_PROFILE);
foreach $profile (@profiles) {
my $fh;
if ($profile eq '') {
$fh = \*DATA;
}
elsif (open(PROFILE, "<$profile")) {
$fh = \*PROFILE;
}
else {
next;
}
# start with 'default'
$case = 'default';
$CASES{$case}++;
while (<$fh>) {
last if /^__END__/; # for sake of SelfLoader
next if /^#/;
chomp;
# continuous line processing (\ at EOL style)
if ($prev_line ne '') {
s/^\s*//;
$_ = $prev_line . $_;
$prev_line = '';
}
if (/\\$/) {
chop;
$prev_line = $_;
next;
}
# Src=inbox#
s/\s#.*$//;
s/\s*$//;
if (/^case\s*(.*)/) {
($case = $1) =~ s/\s*//g;
# make sure %{$case} is true
foreach (split(',', $case)) {
$_->{0} = '';
delete $_->{0};
$CASES{$_}++;
}
next;
}
if (/^use\s+(.*)/) {
($use = $1) =~ s/\s*//g;
my @array = ($case, $use);
push(@USECASES, \@array);
}
if (/^(\*|[\w]+)\.(\w+)[:=]\s*(.*)$/) {
# Imls.Src=+inbox
if ($1 eq '*') {
set_value_cfg($2, $3, $case);
}
if (lc($1) eq progname()) {
my @array = ($2, $3, $case);
push(@prog_cfg, \@array);
}
next;
}
if (/^(\w+)[:=]\s*(.*)$/) {
# Src = +inbox
set_value_cfg($1, $2, $case);
next;
}
}
if ($profile ne '') {
# don't close DATA, and we broke on __END__ for SelfLoader
close (PROFILE);
if ($prev_line ne '') {
im_die("Unexpected EOF at the bottom of config file.\n");
}
}
}
my $array;
foreach $array (@prog_cfg) {
set_value_cfg(@$array);
}
foreach $array (@USECASES) {
($case, $use) = @$array;
foreach (split(',', $case)) {
set_selector($use, $_);
}
}
}
sub read_opt($) {
my $argref = shift;
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.
while ($i < $N) {
$_ = $argref->[$ref];
$i++;
if (/^(--\w+)=(.*)/) {
$name = lc($1);
$val = $2;
$desc = $O_DESC{$name} || im_die("unknown option $name\n");
$vnam = $O_VNAM{$name};
splice(@$argref, $ref, 1);
set_value($desc, $vnam, $val, 'opt');
} elsif (/^(--\w+)$/) {
$name = lc($1);
$desc = $O_DESC{$name} || im_die("unknown option $name\n");
$vnam = $O_VNAM{$name};
if ($desc =~ /s/) {
$val = '';
} elsif ($desc =~ /i/) {
$val = 0;
# } elsif ($desc =~ /f/) { # xxx
# $val = '+inbox';
} elsif ($desc =~ /b/) {
$val = 'on';
} elsif ($desc =~ /B/) {
$val = 'off';
} elsif ($desc =~ /d/) { # for debug option
$val = 'all';
}
set_value($desc, $vnam, $val, 'opt');
splice(@$argref, $ref, 1);
} elsif (/^(-\w+)$/) {
$name = $1;
$name = $O_FULL{$name} if $O_FULL{$name};
$desc = $O_DESC{$name} || im_die("unknown option $name\n");
$vnam = $O_VNAM{$name};
if ($desc =~ /[sifF]/) { # bB never take the next argment
$val = $argref->[$ref + 1];
$i++;
splice(@$argref, $ref, 2);
} elsif ($desc =~ /b/) {
$val = 'on';
splice(@$argref, $ref, 1);
} elsif ($desc =~ /B/) {
$val = 'off';
splice(@$argref, $ref, 1);
}
set_value($desc, $vnam, $val, 'opt');
} elsif (/(^[+\-=%.\/~])|(^[a-zA-Z]:)/ && $O_FOPT) {
$name = $O_FOPT;
$val = $_;
$desc = $O_DESC{$name} || im_die("unknown option $name\n"); # must be F or F@
$vnam = $O_VNAM{$name};
splice(@$argref, $ref, 1);
set_value($desc, $vnam, $val, 'opt');
} else {
# else may be an argment, so let it be...
$ref++;
}
}
}
sub set_selector($;$) {
my($selector, $base) = @_;
my $s;
foreach $s (split(',', $selector)) { ### xxx lc
next if ($s eq 'default');
unless (%{$s}) {
im_err("no 'case $s' in config file.\n");
return -1;
} else {
if (!defined($base) or $base eq 'default') {
push(@SELECTORS, $s) if !defined($base);
foreach (keys(%{$s})) {
${$_} = $s->{$_};
}
} else {
foreach (keys(%{$s})) {
$base->{$_} = $s->{$_};
}
}
}
}
return 0;
}
sub used_selectors() {
return join(',', @SELECTORS);
}
sub sanity_check() {
unless ($MailDir) {
im_die("config files\n" .
"Please setup user profile \"$IM_USER_PROFILE\".\n" .
"MailDir is required.");
}
}
sub help($) {
my $explanation = shift;
my($name, $spec, $desc, $abbr, $dflt);
print "${explanation}\nOptions are: \n";
foreach $name (@O_IORD) {
next unless (defined($O_HELP{$name}));
$desc = $O_DESC{$name};
if ($O_ABBR{$name}) {
$abbr = "($O_ABBR{$name})";
} else {
$abbr = '';
}
if ($desc =~ /^[sifF]\@$/) {
$dflt = join(',', @{$O_VNAM{$name}});
} else {
$dflt = ${$O_VNAM{$name}};
}
$spec = '';
$spec = '' if $desc =~ /^s/;
$spec = '' if $desc =~ /^i/;
$spec = '' if $desc =~ /^[fF]/;
$spec = '' if $desc =~ /^[bB]/;
$spec = "$spec,$spec..." if ($desc =~ /^[sifF]\@$/) && $spec;
$spec = '' if $desc =~ /^d/;
$spec = "=$spec" if $spec;
if ($desc =~ /[bB]/) {
if ($dflt && $dflt =~ /^(on|yes|true|1)$/) {
$dflt = 'on';
} else {
$dflt = 'off';
}
}
print "\t$name$spec $abbr($dflt)\n";
print "\t\t", $O_HELP{$name}, "\n";
}
if ($O_FOPT) {
print "\nNote that +xxx is equivalent to $O_FOPT=+xxx.\n";
}
print "\nReport bugs to .\n";
return 1;
}
##
##
##
sub set_value_cfg($$$) {
my($name, $val, $case) = @_;
my($mnam, $desc, $vnam);
$val =~ s/\$\{(\w+)\}/$ENV{$1}/ge;
if ($val =~ /^\$(.*)/) {
# $InboxFolder -> +inbox
$val = ${$C_VNAM{lc($1)}};
} elsif ($val =~ /^~(.*)/) {
# ~/.im/Config -> $HOME_DIR/.im/Config
$val = "$HOME_DIR$1";
}
$name = lc($name);
$mnam = "--$name";
if ($O_VNAM{$mnam}) {
# $main::opt_help
$desc = $O_DESC{$mnam};
$vnam = $O_VNAM{$mnam};
} elsif ($C_VNAM{$name}) {
# $MailDir
$desc = $C_DESC{$name};
$vnam = $C_VNAM{$name};
}
if ($vnam && $desc) {
foreach (split(',', $case)) {
if ($_ eq 'default') {
set_value($desc, $vnam, $val, 'cfg');
} else {
set_value_case($desc, $vnam, $val, $_);
}
}
}
}
# 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
# require numeric but not numeric, return undef
return undef if ($desc =~ /i/ && $val !~ /\d+/);
if ($desc =~ /\@/) {
# --xxx=foo,bar --xxx=baz
# -> @xxx = (foo, bar, gaz)
my @val = split(',', $val);
if ($desc =~ /F/) { # xxx how about f
my($i, $N) = (0, scalar(@val));
while ($i < $N) {
$val[$i] = "+$val[$i]"
unless $val =~ /(^[+\-=%~\/])|(^[a-zA-Z]:)/;
$i++;
}
}
if (($who eq 'env') || ($who eq 'cfg')) {
# override it
@{$vnam} = @val;
} elsif ($WHO_SET{$vnam} eq 'opt') {
# set by 'opt', so just append.
push(@{$vnam}, @val);
} else {
# set by 'env' or 'cfg' but I'm 'opt', so override it
@{$vnam} = @val;
}
$WHO_SET{$vnam} = $who;
im_debug("\@$vnam = @{$vnam}\n") if &debug('config');
} else {
if ($desc =~ /[bB]/) {
# the difference between 'b' and 'B' appears only when
# value is omitted or "-opt" specified. In that case,
# 'b' becames 1 while 'B' becames 0.
# 'B' never means negate boolean. True is always '1'.
if ($val =~ /^(yes|on|true|1)$/i) {
${$vnam} = 1;
} else {
${$vnam} = 0;
}
} elsif ($desc =~ /F/) { # xxx how about f
# +inbox -> + inbox -> --src +inbox
if ($val =~ /(^[+\-=%~\/])|(^[a-zA-Z]:)/) {
${$vnam} = $val;
} else {
${$vnam} = "+$val";
}
} else {
${$vnam} = $val;
}
im_debug("\$$vnam = ${$vnam}\n") if &debug('config');
}
return 1;
}
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+/);
## $case = lc($case); #xxx
if ($desc =~ /[bB]/) {
if ($val =~ /^(yes|on|true|1)$/i) {
$case->{$vnam} = 1;
} else {
$case->{$vnam} = 0;
}
} elsif ($desc =~ /F/) { # xxx how about f
# +inbox -> + inbox -> --src +inbox
if ($val =~ /(^[+\-=%\/])|(^[a-zA-Z]:)/) {
$case->{$vnam} = $val;
} else {
$case->{$vnam} = "+$val";
}
} else {
$case->{$vnam} = $val;
}
return 1;
}
###
### Config vs Default
###
sub current_dir() {
return $CURRENT_DIR;
}
sub home_dir() {
return $HOME_DIR;
}
sub conf_dir() {
return $IM_USER_DIR;
}
sub mail_dir() {
return $MailDir;
}
sub mail_path() {
return expand_home(mail_dir());
}
sub news_dir() {
return $NewsDir;
}
sub news_path() {
return expand_home(news_dir());
}
sub queue_dir() {
return $QueueDir;
}
sub queue_path() {
expand_path(queue_dir());
}
sub inbox_folder(;$) {
my($case) = split(',', shift); ## use the first one only
if (defined($case) && $case ne 'default' &&
defined($case->{InboxFolder}) &&
$case->{InboxFolder} ne '') {
return $case->{InboxFolder};
} else {
return $InboxFolder;
}
}
sub draft_folder() {
return $DraftFolder;
}
sub trash_folder() {
return $TrashFolder;
}
sub config_cases() {
my @cases = keys(%CASES);
if (scalar(@cases) >= 2) {
return join(',', @cases);
} else {
return '';
}
}
sub config_case_inbox() {
my @cases = keys(%CASES);
my @caseinbox = ();
if (scalar(@cases) >= 2) {
foreach (@cases) {
if (defined($_->{InboxFolder})) {
push(@caseinbox, "$_:$_->{InboxFolder}");
}
}
return join(',', @caseinbox);
} else {
return '';
}
}
sub preserve_dot() {
return $PreserveDot;
}
sub folder_mode($) {
my $setumask = shift;
$FolderMode = oct($FolderMode) if ($FolderMode =~ /^0\d/);
my $umask = 0777 ^ $FolderMode;
umask($umask) if ($setumask);
return $FolderMode;
}
sub msg_mode($) {
my $setumask = shift;
$MsgMode = oct($MsgMode) if ($MsgMode =~ /^0\d/);
my $umask = 0666 ^ $MsgMode;
umask($umask) if ($setumask);
return $MsgMode;
}
sub allowcrlf() {
return $AllowCRLF;
}
sub use_cl() {
return $UseCL;
}
sub no_sync() {
return $NoSync;
}
sub fsync_no() {
return $FSYNC_NO;
}
sub preferred_fsync_no() {
return $FsyncNumber;
}
sub addrbook_file() {
return join(',', map {expand_path($_)} split(',', $AddrBookFile));
}
sub aliases_file() {
return join(',', map {expand_path($_)} split(',', $AliasesFile));
}
sub context_file() {
return &expand_path($ContextFile);
}
sub getchksbr_file() {
return &expand_path($GetChkSbrFile);
}
sub getsbr_file() {
return &expand_path($GetSbrFile);
}
sub scansbr_file() {
return &expand_path($ScanSbrFile);
}
sub scan_header_pick() {
return $ScanHeaderPick;
}
sub petname_file() {
return &expand_path($PetNameFile);
}
sub mail_folders_file() {
return &expand_path($MailFoldersFile);
}
sub address() {
return $Address;
}
sub addresses_regex() {
return $AddrRegex;
}
sub msgdbfile() {
return &expand_path($MsgDBFile);
}
sub msgdbtype() {
return $MsgDBType;
}
sub mbox_style() {
return $MBoxStyle;
}
sub mbox_filter() {
return $MboxFilter;
}
sub nntpservers() {
return $NNTPservers;
}
sub nntphistoryfile() {
return &expand_path($NNTPhistory);
}
sub nntpauthuser() {
return $NNTPauthuser;
}
sub set_nntpauthuser($) {
$NNTPauthuser = shift;
}
sub popaccount() {
return $POPaccount;
}
sub pophistoryfile() {
return &expand_path($POPhistory);
}
sub imapaccount() {
return $IMAPaccount;
}
sub smtpaccount() {
return $SMTPaccount;
}
sub httpproxy() {
return $HTTPproxy;
}
sub noproxy() {
return $Noproxy;
}
sub usepwagent() {
return $UsePwAgent;
}
sub pwagentport() {
return $PwAgentPort;
}
sub pwagent_tmp_dir() {
return $PwAgentTmpDir;
}
sub pwagent_tmp_path() {
return expand_path(pwagent_tmp_dir());
}
sub usepwfiles() {
return $UsePwFiles;
}
sub pwfiles() {
return $PwFiles;
}
sub use_xdispatcher() {
return $UseXDispatcher;
}
sub usetouchfile() {
return $UseTouchFile;
}
sub touchfile() {
return $TouchFile;
}
sub pop_timeout() {
return $PopTimeout;
}
sub imap_timeout() {
return $ImapTimeout;
}
sub nntp_timeout() {
return $NntpTimeout;
}
sub dns_timeout() {
return $DnsTimeout;
}
sub connect_timeout() {
return $ConnectTimeout;
}
sub command_timeout() {
return $CommandTimeout;
}
sub rcv_buf_siz() {
return $RcvBufSiz;
}
sub db_type() {
return $IM_DB_TYPE;
}
sub ssh_path() {
return $SshPath || $SSH_PATH;
}
sub namazuv2() {
return $NamazuV2;
}
sub namazu_dir() {
return $NamazuDir;
}
sub namazu_path() {
return expand_home(namazu_dir());
}
sub mknmz_options() {
return $MknmzOptions;
}
sub mknmz_include_file() {
return &expand_path($MknmzIncludeFile);
}
sub mknmz_ignore_folders_regex() {
return $MknmzIgnoreFoldersRegex;
}
sub namazu_lock_dir() {
return $NamazuLockDir;
}
sub namazu_lock_path() {
return expand_path(namazu_lock_dir());
}
###
### path expansion
###
sub expand_home($) {
my $folder = shift;
return '' if ($folder eq '');
if ($folder =~ /^\//) {
# nothing
} elsif ($folder =~ /^[a-zA-Z]:\//) {
# nothing
} elsif ($folder =~ /^\~\/(.*)/) {
$folder = home_dir() . '/' . $1;
} else {
$folder = home_dir() . '/' . $folder;
}
return $folder;
}
sub expand_path($) {
my $folder = shift;
$folder =~ s/^\s*(.*?)\s*$/$1/; # SPC may be used in folder names
return '' unless $folder;
if ($folder =~ /^\//) {
# nothing
} elsif ($folder eq '.') {
$folder = current_dir();
} elsif ($folder eq '..') {
$folder = current_dir() . '/..';
} elsif ($folder =~ /^\.\//) {
$folder = current_dir() . '/' . $folder;
} elsif ($folder =~ /^-/) {
$folder = '';
} elsif ($folder =~ /^\%/) {
$folder = '';
} elsif ($folder =~ /^\+(.*)/) {
$folder = mail_path() . '/' . $1;
} elsif ($folder =~ /^=(.*)/) {
$folder = $1;
$folder =~ s/\./\//g unless preserve_dot();
$folder = news_path() . '/' . $folder;
} elsif ($folder =~ /^[a-zA-Z]:\//) {
# nothing
} elsif ($folder =~ /^\~\/(.*)/) {
$folder = home_dir() . '/' . $1;
} elsif (&unixp() && $folder =~ /^\~([^\/]+)\/(.*)/) {
$folder = (getpwnam($1))[7] . '/' . $2;
} else {
$folder = conf_dir() . '/' . $folder;
}
return $folder;
}
1;
__DATA__
##
## Default global parameters
##
MailDir=Mail # relative to ~/
NewsDir=News # relative to ~/
# folders for mail messages
InboxFolder=+inbox # default destination of imget
DraftFolder=+draft
TrashFolder=+trash # default destination of message removal in mew
# mode for creation
FolderMode=0700
MsgMode=0600
# to keep state of IM commands (CurrentFolder, etc.)
ContextFile=Context # relative to ~/.im/
##
## Default settings
##
# folders
Src=$InboxFolder # default source of most commands
Imclean.Src=$TrashFolder # default source for message cleanups
Immknmz.Src= # folders specified by Mail/.folders are used
#Imget.dst=$InboxFolder # default inbox folder
Imrm.dst=$TrashFolder # default trash folder
# mail address aliases for imali/imput
AddrBookFile=Addrbook # relative to ~/.im/
AliasesFile=Aliases # relative to ~/.im/
#PetnameFile=Petnames # relative to ~/.im/
MailFoldersFile=~/Mail/.folders
UseTouchFile=off
TouchFile=.mew-touch
# imget/imls
Form=%+5n %m%d %-14A %S || %b # default format for scanning
Width=80 # default width for scanning
JisSafe=on # escape seq. of JIS char. should be managed
Indent=2 # indent step for threading
DupCheckTarget=message-id # Duplicate Check Target
# 'message-id' or 'message-id+subject'
ImGrep.DupCheckTarget=none
# servers
Smtpservers=localhost # default server for SMTP
NntpServers=localhost # default server for NNTP
# imput
FccDir=$MailDir
QueueDir=queue # relative to ~/.im/
UseXDispatcher=on # use X-Dispatcher field
# imget
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=yes # use Namazu version 2 (1.9.x or late)
NamazuDir=Namazu # relative to ~/
NamazuLockDir=nmzlock # lock directory (relative to ~/.im/)
#MknmzOptions=--decode-base64 # options for mknmz
MknmzIncludeFile=~/Namazu/mknmz-inc.pl # mknmz -I
MknmzIgnoreFoldersRegex=\+(attach|draft|trash|queue|postq|schedule)
__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 preferred_fsync_no
addrbook_file aliases_file petname_file mail_folders_file
context_file getchksbr_file getsbr_file scansbr_file scan_header_pick
address addresses_regex
msgdbfile msgdbtype
mbox_style mbox_filter
nntpservers nntphistoryfile nntpauthuser set_nntpauthuser
popaccount pophistoryfile imapaccount smtpaccount httpproxy noproxy
usepwagent pwagentport pwagent_tmp_dir pwagent_tmp_path usepwfiles pwfiles
expand_path use_xdispatcher usetouchfile touchfile
namazuv2 namazu_dir namazu_path namazu_lock_dir namazu_lock_path
mknmz_options mknmz_include_file mknmz_ignore_folders_regex
pop_timeout imap_timeout nntp_timeout dns_timeout
connect_timeout command_timeout rcv_buf_siz
db_type file_attr ssh_path
=head1 DESCRIPTION
The I 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.
###
### 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.