1# -*-Perl-*-
2################################################################
3###
4###			      Config.pm
5###
6### Author:  Internet Message Group <img@mew.org>
7### Created: Apr 23, 1997
8### Revised: May 25, 2011
9###
10
11my $PM_VERSION = "IM::Config.pm version 20161010(IM153)";
12
13package IM::Config;
14require 5.003;
15require Exporter;
16
17use IM::Util;
18use integer;
19use strict 'vars';
20use strict 'subs';
21use vars qw(@ISA @EXPORT);
22
23@ISA = qw(Exporter);
24@EXPORT = qw(
25    read_cfg_selector
26    init_opt
27    read_env read_cfg read_opt
28    set_selector used_selectors
29    sanity_check
30    help
31    home_dir conf_dir
32    mail_dir mail_path news_dir news_path queue_dir queue_path
33    inbox_folder draft_folder trash_folder config_cases config_case_inbox
34    preserve_dot
35    folder_mode msg_mode allowcrlf use_cl no_sync fsync_no preferred_fsync_no
36    addrbook_file aliases_file petname_file mail_folders_file
37    context_file getchksbr_file getsbr_file scansbr_file scan_header_pick
38    address addresses_regex
39    msgdbfile msgdbtype
40    mbox_style mbox_filter
41    nntpservers nntphistoryfile nntpauthuser set_nntpauthuser
42    popaccount pophistoryfile imapaccount smtpaccount httpproxy noproxy
43    usepwagent pwagentport pwagent_tmp_dir pwagent_tmp_path usepwfiles pwfiles
44    expand_path use_xdispatcher usetouchfile touchfile
45    namazuv2 namazu_dir namazu_path namazu_lock_dir namazu_lock_path
46    mknmz_options mknmz_include_file mknmz_ignore_folders_regex
47    pop_timeout imap_timeout nntp_timeout dns_timeout
48    connect_timeout command_timeout rcv_buf_siz
49    db_type file_attr ssh_path);
50
51##
52## Constant
53##
54use vars qw($CURRENT_DIR $HOME_DIR $IM_SYS_DIR
55	    $IM_USER_DIR $IM_SYS_PROFILE $IM_USER_PROFILE
56	    @CfgConfig %CASES
57	    @O_IORD %O_DESC %O_VNAM %O_FULL %O_ABBR %O_HELP
58	    $O_FOPT %C_DESC %C_VNAM
59	    %WHO_SET
60	    @SELECTORS
61	    $IM_SYSCONFDIR $IM_DB_TYPE $FSYNC_NO
62	    $prefix $exec_prefix $SSH_PATH);
63
64##
65## configurable value by configure
66##
67
68$prefix="@prefix@";
69$exec_prefix= "@exec_prefix@";
70$IM_SYSCONFDIR  = "@sysconfdir@/im";
71$IM_DB_TYPE = '@im_db_type@';
72$FSYNC_NO = @im_fsync_no@;
73$SSH_PATH = "@im_path_ssh@";
74
75sub file_attr() {
76    return @im_file_attr@;
77}
78
79##
80##
81
82$CURRENT_DIR = $ENV{'PWD'} || eval { use Cwd; fastcwd(); } ||
83    im_die("can't get your current directory\n");
84
85$HOME_DIR = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7] ||
86    im_die("can't get your home directory\n");
87$HOME_DIR =~ s:\\:/:g;     # "\home\user" -> "/home/user"
88$HOME_DIR =~ s/\/$//;      # "/home/" -> "/home"
89
90$IM_SYS_DIR = $ENV{'IM_SYS_DIR'} || "$IM_SYSCONFDIR";
91$IM_USER_DIR = &expand_home($ENV{'IM_USER_DIR'} || '.im');
92
93$IM_SYS_PROFILE = "$IM_SYS_DIR/SiteConfig";
94$IM_USER_PROFILE = "$IM_USER_DIR/Config";
95
96##
97##
98##
99BEGIN {
100
101@CfgConfig = (
102    'maildir;s;;MailDir'	=> 'A directory to contain mail messages',
103    'newsdir;s;;NewsDir'	=> 'A directory to contain news messages',
104    'queuedir;s;;QueueDir'      => 'A directory to store messages to be sent',
105    'inboxfolder;f;;InboxFolder'	=> 'Inbox folder',
106    'draftfolder;f;;DraftFolder'	=> 'Draft folder',
107    'trashfolder;f;;TrashFolder'	=> 'Trash folder',
108    'foldermode;i;;FolderMode'		=> 'Folder directory mode when created',
109    'msgmode;i;;MsgMode'		=> 'Message file mode when created',
110    'usecl;b;;UseCL' => 'Use value of Content-Length header for delimitation',
111    'nosync;b;;NoSync'		=> 'Do not need fsync(2) on writing file',
112    'fsyncnumber;i;;FsyncNumber'	=> 'System call number of fsync',
113    'sshpath;s;;SshPath'		=> 'Path name of SSH program',
114    'allowcrlf;b;;AllowCRLF'		=> 'CRLF may be in saved message',
115    'preservedot;b;;PreserveDot'	=> 'Not substitute "." with "/"',
116    'addrbookfile;s;;AddrBookFile'      => 'Address book file',
117    'aliasesfile;s;;AliasesFile'        => 'Aliases file',
118    'petnamefile;s;;PetNameFile'	=> 'PetName file',
119    'petnamefile;s;;PetNameFile'	=> 'PetName file',
120    'mailfoldersfile;s;;MailFoldersFile'	=> 'Mail folders file',
121    'contextfile;s;Context;ContextFile'	=> 'Context file',
122    'address;s;;Address'		=> 'Email addresses',
123    'addrregex;s;;AddrRegex'		=> 'Email addresses by regex',
124    'msgdbfile;s;;MsgDBFile'		=> 'Message database location',
125    'msgdbtype;s;;MsgDBType'		=> 'Message database type',
126    'getchksbr;s;;GetChkSbrFile'	=> 'GetChk hook subroutine script',
127    'getsbr;s;;GetSbrFile'		=> 'Get hook subroutine script',
128    'scansbr;s;;ScanSbrFile'		=> 'Scan hook subroutine script',
129    'scanheaderpick;s;;ScanHeaderPick'  => 'Scan headers to pick up',
130    'mboxstyle;s;;MBoxStyle'		=> 'Style of local mailbox format',
131    'mboxfilter;s;;MboxFilter'		=> 'Filter for mbox file',
132    'nntpservers;s;;NNTPservers'	=> 'List of NNTP servers',
133    'nntphistory;s;;NNTPhistory'	=> 'Status file of NNTP access',
134    'nntpauthuser;s;;NNTPauthuser'	=> 'User name for NNTP authentication',
135    'popaccount;s;;POPaccount'		=> 'Account info for POP access',
136    'pophistory;s;;POPhistory'		=> 'Status file of POP access',
137    'imapaccount;s;;IMAPaccount'	=> 'Account info for IMAP access',
138    'smtpaccount;s;;SMTPaccount'	=> 'Account info for SMTP authentication',
139    'httpproxy;s;;HTTPproxy'		=> 'Proxy server for HTTP access',
140    'noproxy;s;;Noproxy'		=> 'URL regex not to use Proxy server',
141    'usepwagent;b;;UsePwAgent'		=> 'Use password agent',
142    'pwagentport;i;;PwAgentPort'	=> 'Port to connect agent with TCP/IP',
143    'pwagenttmpdir;s;;PwAgentTmpDir'	=> 'Temporary directory for impwagent',
144    'usepwfiles;b;;UsePwFiles'		=> 'Use password files',
145    'pwfiles;s;;PwFiles'		=> 'Password files',
146    'poptimeout;i;20;PopTimeout'	=> 'Timeout for POP connection',
147    'imaptimeout;i;20;ImapTimeout'	=> 'Timeout for IMAP connection',
148    'nntptimeout;i;20;NntpTimeout'	=> 'Timeout for NNTP connection',
149    'dnstimeout;i;60;DnsTimeout'	=> 'Timeout for DNS connection',
150    'connecttimeout;i;60;ConnectTimeout'  => 'Timeout for connection making',
151    'commandtimeout;i;300;CommandTimeout' => 'Timeout for each command',
152    'rcvbufsiz;i;;RcvBufSiz'		=> 'Receive buffer size of TCP',
153    'usexdispatcher;b;;UseXDispatcher'	=> 'Use X-Dispatcher field',
154    'usetouchfile;b;;UseTouchFile'	=> 'Use touch file',
155    'touchfile;s;;TouchFile'		=> 'Touch file name',
156    'namazuv2;b;;NamazuV2'		=> 'Use Namazu Version 2 (1.9 or late)',
157    'namazudir;s;;NamazuDir'	=> 'A directory to contain Namazu indexes',
158    'namazulockdir;s;;NamazuLockDir'	=> 'Lock directory for Namazu',
159    'mknmzoptions;s;;MknmzOptions'	=> 'Options for mknmz',
160    'mknmzincludefile;s;;MknmzIncludeFile'	=> 'A file for mknmz -I',
161    'mknmzignorefoldersregex;s;;MknmzIgnoreFoldersRegex'	=> 'Folders regex ignored by immknmz',
162    );
163
164    # these vars should be in current package?
165    my(@vars) = ();
166    my($i, $name, $desc, $dflt, $vnam);
167    for ($i = 0; $i < $#CfgConfig; $i+=2) {
168	($name, $desc, $dflt, $vnam) = split(';', $CfgConfig[$i]);
169	if ($vnam) {
170	    push(@vars, '$' . $vnam);  #'
171        }
172    }
173    # print "use vars qw(@vars);\n";
174    eval "use vars qw(@vars);";
175}
176
177##
178##
179##
180
181sub read_cfg_selector($) {
182    my $argvref = shift;
183    my $i = 0;
184    my $selector = '';
185
186    foreach $a (@$argvref) {
187	if ($a =~ /^--config=(.*)$/i) {
188	    $selector = $1;
189## side effect!
190## --config=value is removed from @ARGV
191	    splice(@$argvref, $i, 1);
192	}
193	$i++;
194    }
195    return $selector;
196}
197
198sub init_opt($;$) {
199    my($optref, $cptref) = @_;
200    my($name, $desc, $dflt, $vnam, $optn, $help);
201    my($i, $N);
202
203    @O_IORD = (); ## option list in order
204    %O_DESC = (); # --help -> s|s@|i|i@|f|f@|F|F@|b|B
205    %O_VNAM = (); # --help -> help
206    %O_FULL = (); # -h -> --help
207    %O_ABBR = (); # --help -> -h
208    %O_HELP = (); # --help -> "help message"
209
210    # $O_FOPT;    # --src or --dst for help
211
212    %C_DESC = (); # address -> s|s@|i|f|f@|b|B
213    %C_VNAM = (); # address -> Address
214
215    # set @CfgConfig
216    $i = 0;
217    $N = scalar(@CfgConfig);
218    while ($i < $N) {
219	($name, $desc, $dflt, $vnam) = split(';', $CfgConfig[$i]);
220	$i += 2;
221	if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B)$/) {
222	    $optn = $name;
223	    if ($vnam) {
224		# no main:: !
225		$C_VNAM{$optn} = $vnam;
226	    } else {
227		$C_VNAM{$optn} = "main::opt_\L$name";
228	    }
229	    $C_DESC{$optn} = $desc;
230	    ${$C_VNAM{$optn}} = $dflt if $dflt;
231	} else {
232	    im_warn("invalid opt desc ``$desc'' for $optn\n");
233	    return undef;
234	}
235    }
236
237    # set @OptConfig
238    $i = 0;
239    $N = scalar(@$optref);
240    while ($i < $N) {
241	($name, $desc, $dflt, $vnam) = split(';', $$optref[$i]);
242	$i++;
243	$help = $$optref[$i];
244	$i++;
245	if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B|d)$/) {
246	    my $abbr;
247	    if ($name =~ ',') {
248		($name, $abbr) = split(',', $name);
249		$abbr = "-$abbr";
250	    }
251	    $optn = lc("--$name");
252	    push(@O_IORD, $optn);
253	    if ($vnam) {
254		$O_VNAM{$optn} = "main::$vnam";
255	    } else {
256		$O_VNAM{$optn} = "main::opt_\L$name";
257	    }
258	    ${$O_VNAM{$optn}} = $dflt if $dflt;
259	    $O_DESC{$optn} = $desc;
260	    $O_HELP{$optn} = $help;
261	    unless ($cptref || $desc eq 'd') {
262		# no @CptConfig, so set abbrev
263		$abbr = substr($optn, 1, 2) unless $abbr;  # -h
264		$O_FULL{$abbr} = $optn;
265		$O_ABBR{$optn} = $abbr;
266	    }
267	    $O_FOPT = $optn if $desc =~ /^F/;
268	} else {
269	    im_warn("invalid opt desc ``$desc'' for $optn\n\n");
270	    return undef;
271	}
272    }
273    # set @CptConfig
274    if ($cptref) {
275	$i = 0;
276	$N = scalar(@$cptref);
277	while ($i < $N) {
278	    ($name, $desc, $dflt, $vnam) = split(';', $cptref->[$i]);
279    	    $i++;
280	    $help = $cptref->[$i];
281	    $i++;
282	    if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B)$/) {
283	        $optn = "-$name"; ## no lc()
284		push(@O_IORD, $optn);
285	        if ($vnam) {
286		    $O_VNAM{$optn} = "main::$vnam";
287	        } else {
288		    $O_VNAM{$optn} = "main::opt_\L$name";
289	        }
290		# $dflt should be "off" if /b/ and "on" if /B/ usually
291		# but no such limitations here to allow -opt and -noopt pair.
292		${$O_VNAM{$optn}} = $dflt if $dflt;
293	        $O_DESC{$optn} = $desc;
294	        $O_HELP{$optn} = $help;
295	    } else {
296	        im_warn("invalid opt desc ``$desc'' for $optn\n\n");
297	        return undef;
298	    }
299	}
300    }
301
302    return 1;
303}
304
305sub read_env($) {
306    my $envref = shift;
307    my($i, $N) = (0, scalar(@$envref));
308    my($name, $desc, $dflt, $var);
309
310    while ($i < $N) {
311	($name, $desc, $dflt, $var) =  split(';', $envref->[$i]);
312	if ($ENV{$name}) {
313	    set_value($desc, $var, $ENV{$name}, 'env');
314	} elsif ($dflt) {  # not else !
315	    set_value($desc, $var, $dflt, 'env');
316	}
317	$i++;
318    }
319}
320
321sub read_cfg() {
322    my($profile, @profiles);
323    my $prev_line = '';
324    my $case;
325    my $use;
326    my @USECASES;
327    my @prog_cfg;
328
329    @profiles = ('<DATA>', $IM_SYS_PROFILE, $IM_USER_PROFILE);
330
331    foreach $profile (@profiles) {
332	my $fh;
333	if ($profile eq '<DATA>') {
334	    $fh = \*DATA;
335	}
336	elsif (open(PROFILE, "<$profile")) {
337	    $fh = \*PROFILE;
338	}
339	else {
340	    next;
341	}
342
343	# start with 'default'
344	$case = 'default';
345	$CASES{$case}++;
346	while (<$fh>) {
347	    last if /^__END__/;	# for sake of SelfLoader
348	    next if /^#/;
349	    chomp;
350	    # continuous line processing (\ at EOL style)
351	    if ($prev_line ne '') {
352		s/^\s*//;
353		$_ = $prev_line . $_;
354		$prev_line = '';
355	    }
356	    if (/\\$/) {
357		chop;
358		$prev_line = $_;
359		next;
360	    }
361	    # Src=inbox<space>#<any>
362	    s/\s#.*$//;
363	    s/\s*$//;
364	    if (/^case\s*(.*)/) {
365		($case = $1) =~ s/\s*//g;
366		# make sure %{$case} is true
367		foreach (split(',', $case)) {
368		    $_->{0} = '';
369		    delete $_->{0};
370		    $CASES{$_}++;
371		}
372		next;
373	    }
374	    if (/^use\s+(.*)/) {
375		($use = $1) =~ s/\s*//g;
376		my @array = ($case, $use);
377		push(@USECASES, \@array);
378	    }
379	    if (/^(\*|[\w]+)\.(\w+)[:=]\s*(.*)$/) {
380		# Imls.Src=+inbox
381		if ($1 eq '*') {
382		    set_value_cfg($2, $3, $case);
383		}
384		if (lc($1) eq progname()) {
385		    my @array = ($2, $3, $case);
386		    push(@prog_cfg, \@array);
387		}
388		next;
389	    }
390	    if (/^(\w+)[:=]\s*(.*)$/) {
391		# Src = +inbox
392    		set_value_cfg($1, $2, $case);
393		next;
394	    }
395	}
396	if ($profile ne '<DATA>') {
397	    # don't close DATA, and we broke on __END__ for SelfLoader
398	    close (PROFILE);
399	    if ($prev_line ne '') {
400		im_die("Unexpected EOF at the bottom of config file.\n");
401	    }
402	}
403    }
404
405    my $array;
406    foreach $array (@prog_cfg) {
407	set_value_cfg(@$array);
408    }
409    foreach $array (@USECASES) {
410	($case, $use) = @$array;
411	foreach (split(',', $case)) {
412	    set_selector($use, $_);
413	}
414    }
415}
416
417sub read_opt($) {
418    my $argref = shift;
419    my($ref, $i, $N) = (0, 0, scalar(@$argref));
420    my($name, $val, $desc, $vnam);
421
422    # delete options from @ARGV so that main{} can treat
423    # @ARGV as argments.
424
425    while ($i < $N) {
426	$_ = $argref->[$ref];
427	$i++;
428	if (/^(--\w+)=(.*)/) {
429	    $name = lc($1);
430	    $val = $2;
431	    $desc = $O_DESC{$name} || im_die("unknown option $name\n");
432	    $vnam = $O_VNAM{$name};
433	    splice(@$argref, $ref, 1);
434	    set_value($desc, $vnam, $val, 'opt');
435	} elsif (/^(--\w+)$/) {
436	    $name = lc($1);
437	    $desc = $O_DESC{$name} || im_die("unknown option $name\n");
438	    $vnam = $O_VNAM{$name};
439	    if ($desc =~ /s/) {
440		$val = '';
441	    } elsif ($desc =~ /i/) {
442		$val = 0;
443#	    } elsif ($desc =~ /f/) { # xxx
444#		$val = '+inbox';
445	    } elsif ($desc =~ /b/) {
446		$val = 'on';
447	    } elsif ($desc =~ /B/) {
448		$val = 'off';
449	    } elsif ($desc =~ /d/) { # for debug option
450		$val = 'all';
451	    }
452	    set_value($desc, $vnam, $val, 'opt');
453	    splice(@$argref, $ref, 1);
454	} elsif (/^(-\w+)$/) {
455	    $name = $1;
456	    $name = $O_FULL{$name} if $O_FULL{$name};
457	    $desc = $O_DESC{$name} || im_die("unknown option $name\n");
458	    $vnam = $O_VNAM{$name};
459	    if ($desc =~ /[sifF]/) { # bB never take the next argment
460		$val = $argref->[$ref + 1];
461		$i++;
462		splice(@$argref, $ref, 2);
463	    } elsif ($desc =~ /b/) {
464		$val = 'on';
465		splice(@$argref, $ref, 1);
466	    } elsif ($desc =~ /B/) {
467		$val = 'off';
468		splice(@$argref, $ref, 1);
469	    }
470	    set_value($desc, $vnam, $val, 'opt');
471	} elsif (/(^[+\-=%.\/~])|(^[a-zA-Z]:)/ && $O_FOPT) {
472	    $name = $O_FOPT;
473	    $val = $_;
474	    $desc = $O_DESC{$name} || im_die("unknown option $name\n"); # must be F or F@
475	    $vnam = $O_VNAM{$name};
476	    splice(@$argref, $ref, 1);
477	    set_value($desc, $vnam, $val, 'opt');
478	} else {
479	    # else may be an argment, so let it be...
480	    $ref++;
481	}
482    }
483}
484
485sub set_selector($;$) {
486    my($selector, $base) = @_;
487    my $s;
488
489    foreach $s (split(',', $selector)) { ### xxx lc
490	next if ($s eq 'default');
491	unless (%{$s}) {
492	    im_err("no 'case $s' in config file.\n");
493	    return -1;
494	} else {
495	    if (!defined($base) or $base eq 'default') {
496	        push(@SELECTORS, $s) if !defined($base);
497	        foreach (keys(%{$s})) {
498	    	    ${$_} = $s->{$_};
499	        }
500	    } else {
501	        foreach (keys(%{$s})) {
502		    $base->{$_} = $s->{$_};
503	        }
504	    }
505	}
506    }
507    return 0;
508}
509
510sub used_selectors() {
511    return join(',', @SELECTORS);
512}
513
514sub sanity_check() {
515    unless ($MailDir) {
516	im_die("config files\n" .
517	       "Please setup user profile \"$IM_USER_PROFILE\".\n" .
518	       "MailDir is required.");
519    }
520}
521
522sub help($) {
523    my $explanation = shift;
524    my($name, $spec, $desc, $abbr, $dflt);
525
526    print "${explanation}\nOptions are: \n";
527
528    foreach $name (@O_IORD) {
529	next unless (defined($O_HELP{$name}));
530
531	$desc = $O_DESC{$name};
532	if ($O_ABBR{$name}) {
533	    $abbr = "($O_ABBR{$name})";
534	} else {
535	    $abbr = '';
536	}
537	if ($desc =~ /^[sifF]\@$/) {
538	    $dflt = join(',', @{$O_VNAM{$name}});
539	} else {
540  	    $dflt = ${$O_VNAM{$name}};
541	}
542
543	$spec = '';
544
545	$spec = '<string>'         if $desc =~ /^s/;
546	$spec = '<num>'            if $desc =~ /^i/;
547	$spec = '<folder>'         if $desc =~ /^[fF]/;
548	$spec = '<on|off>'         if $desc =~ /^[bB]/;
549	$spec = "$spec,$spec..."   if ($desc =~ /^[sifF]\@$/) && $spec;
550	$spec = '<debug option>'   if $desc =~ /^d/;
551	$spec = "=$spec"           if $spec;
552
553	if ($desc =~ /[bB]/) {
554	    if ($dflt && $dflt =~ /^(on|yes|true|1)$/) {
555		$dflt = 'on';
556	    } else {
557		$dflt = 'off';
558	    }
559	}
560
561	print "\t$name$spec $abbr($dflt)\n";
562	print "\t\t", $O_HELP{$name}, "\n";
563    }
564
565    if ($O_FOPT) {
566	print "\nNote that +xxx is equivalent to $O_FOPT=+xxx.\n";
567    }
568    print "\nReport bugs to <tats\@vega.ocn.ne.jp>.\n";
569    return 1;
570}
571
572##
573##
574##
575
576sub set_value_cfg($$$) {
577    my($name, $val, $case) = @_;
578    my($mnam, $desc, $vnam);
579
580    $val =~ s/\$\{(\w+)\}/$ENV{$1}/ge;
581    if ($val =~ /^\$(.*)/) {
582	# $InboxFolder -> +inbox
583	$val = ${$C_VNAM{lc($1)}};
584    } elsif ($val =~ /^~(.*)/) {
585	# ~/.im/Config -> $HOME_DIR/.im/Config
586	$val = "$HOME_DIR$1";
587    }
588
589    $name = lc($name);
590    $mnam = "--$name";
591    if ($O_VNAM{$mnam}) {
592	# $main::opt_help
593	$desc = $O_DESC{$mnam};
594	$vnam = $O_VNAM{$mnam};
595    } elsif ($C_VNAM{$name}) {
596	# $MailDir
597	$desc = $C_DESC{$name};
598	$vnam = $C_VNAM{$name};
599    }
600    if ($vnam && $desc) {
601        foreach (split(',', $case)) {
602	    if ($_ eq 'default') {
603		set_value($desc, $vnam, $val, 'cfg');
604	    } else {
605		set_value_case($desc, $vnam, $val, $_);
606	    }
607	}
608    }
609}
610
611# set_value is not in safe manner.
612# see if $desc exists before calling this.
613
614sub set_value($$$$) {
615    my($desc, $vnam, $val, $who) = @_;  # b, $main::opt_help, yes
616
617    # require numeric but not numeric, return undef
618    return undef if ($desc =~ /i/ && $val !~ /\d+/);
619
620    if ($desc =~ /\@/) {
621	# --xxx=foo,bar --xxx=baz
622	# -> @xxx = (foo, bar, gaz)
623	my @val = split(',', $val);
624	if ($desc =~ /F/) { # xxx how about f
625	    my($i, $N) = (0, scalar(@val));
626	    while ($i < $N) {
627		$val[$i] = "+$val[$i]"
628		    unless $val =~ /(^[+\-=%~\/])|(^[a-zA-Z]:)/;
629		$i++;
630	    }
631	}
632	if (($who eq 'env') || ($who eq 'cfg')) {
633	    # override it
634	    @{$vnam} = @val;
635	} elsif ($WHO_SET{$vnam} eq 'opt') {
636	    # set by 'opt', so just append.
637	    push(@{$vnam}, @val);
638	} else {
639	    # set by 'env' or 'cfg' but I'm 'opt', so override it
640	    @{$vnam} = @val;
641	}
642	$WHO_SET{$vnam} = $who;
643	im_debug("\@$vnam = @{$vnam}\n") if &debug('config');
644    } else {
645	if ($desc =~ /[bB]/) {
646	    # the difference between 'b' and 'B' appears only when
647	    # value is omitted or "-opt" specified. In that case,
648	    # 'b' becames 1 while 'B' becames 0.
649	    # 'B' never means negate boolean. True is always '1'.
650	    if ($val =~ /^(yes|on|true|1)$/i) {
651		${$vnam} = 1;
652	    } else {
653		${$vnam} = 0;
654	    }
655	} elsif ($desc =~ /F/) {  # xxx how about f
656	    # +inbox -> + inbox -> --src +inbox
657	    if ($val =~ /(^[+\-=%~\/])|(^[a-zA-Z]:)/) {
658		${$vnam} = $val;
659	    } else {
660		${$vnam} = "+$val";
661	    }
662	} else {
663	    ${$vnam} = $val;
664	}
665	im_debug("\$$vnam = ${$vnam}\n") if &debug('config');
666    }
667
668    return 1;
669}
670
671sub set_value_case($$$$) {
672    my($desc, $vnam, $val, $case) = @_;  # b, $main::opt_help, yes
673
674    # require numeric but not numeric, return undef
675    return undef if ($desc =~ /i/ && $val !~ /\d+/);
676##    $case = lc($case); #xxx
677
678    if ($desc =~ /[bB]/) {
679	if ($val =~ /^(yes|on|true|1)$/i) {
680	    $case->{$vnam} = 1;
681	} else {
682	    $case->{$vnam} = 0;
683	}
684    } elsif ($desc =~ /F/) {  # xxx how about f
685	# +inbox -> + inbox -> --src +inbox
686	if ($val =~ /(^[+\-=%\/])|(^[a-zA-Z]:)/) {
687	    $case->{$vnam} = $val;
688	} else {
689	    $case->{$vnam} = "+$val";
690	}
691    } else {
692	$case->{$vnam} = $val;
693    }
694
695    return 1;
696}
697
698###
699### Config vs Default
700###
701
702sub current_dir() {
703    return $CURRENT_DIR;
704}
705
706sub home_dir() {
707    return $HOME_DIR;
708}
709
710sub conf_dir() {
711    return $IM_USER_DIR;
712}
713
714sub mail_dir() {
715    return $MailDir;
716}
717
718sub mail_path() {
719    return expand_home(mail_dir());
720}
721
722sub news_dir() {
723    return $NewsDir;
724}
725
726sub news_path() {
727    return expand_home(news_dir());
728}
729
730sub queue_dir() {
731    return $QueueDir;
732}
733
734sub queue_path() {
735    expand_path(queue_dir());
736}
737
738sub inbox_folder(;$) {
739    my($case) = split(',', shift); ## use the first one only
740    if (defined($case) && $case ne 'default' &&
741	defined($case->{InboxFolder}) &&
742	$case->{InboxFolder} ne '') {
743	return $case->{InboxFolder};
744    } else {
745	return $InboxFolder;
746    }
747}
748
749sub draft_folder() {
750    return $DraftFolder;
751}
752
753sub trash_folder() {
754    return $TrashFolder;
755}
756
757sub config_cases() {
758    my @cases = keys(%CASES);
759    if (scalar(@cases) >= 2) {
760	return join(',', @cases);
761    } else {
762	return '';
763    }
764}
765
766sub config_case_inbox() {
767    my @cases = keys(%CASES);
768    my @caseinbox = ();
769    if (scalar(@cases) >= 2) {
770	foreach (@cases) {
771	    if (defined($_->{InboxFolder})) {
772		push(@caseinbox, "$_:$_->{InboxFolder}");
773	    }
774	}
775        return join(',', @caseinbox);
776    } else {
777  	return '';
778    }
779}
780
781sub preserve_dot() {
782    return $PreserveDot;
783}
784
785sub folder_mode($) {
786    my $setumask = shift;
787
788    $FolderMode = oct($FolderMode) if ($FolderMode =~ /^0\d/);
789    my $umask = 0777 ^ $FolderMode;
790    umask($umask) if ($setumask);
791    return $FolderMode;
792}
793
794sub msg_mode($) {
795    my $setumask = shift;
796
797    $MsgMode = oct($MsgMode) if ($MsgMode =~ /^0\d/);
798    my $umask = 0666 ^ $MsgMode;
799    umask($umask) if ($setumask);
800    return $MsgMode;
801}
802
803sub allowcrlf() {
804    return $AllowCRLF;
805}
806
807sub use_cl() {
808    return $UseCL;
809}
810
811sub no_sync() {
812    return $NoSync;
813}
814
815sub fsync_no() {
816    return $FSYNC_NO;
817}
818
819sub preferred_fsync_no() {
820    return $FsyncNumber;
821}
822
823sub addrbook_file() {
824    return join(',', map {expand_path($_)} split(',', $AddrBookFile));
825}
826
827sub aliases_file() {
828    return join(',', map {expand_path($_)} split(',', $AliasesFile));
829}
830
831sub context_file() {
832    return &expand_path($ContextFile);
833}
834
835sub getchksbr_file() {
836    return &expand_path($GetChkSbrFile);
837}
838
839sub getsbr_file() {
840    return &expand_path($GetSbrFile);
841}
842
843sub scansbr_file() {
844    return &expand_path($ScanSbrFile);
845}
846
847sub scan_header_pick() {
848    return $ScanHeaderPick;
849}
850
851sub petname_file() {
852    return &expand_path($PetNameFile);
853}
854
855sub mail_folders_file() {
856    return &expand_path($MailFoldersFile);
857}
858
859sub address() {
860    return $Address;
861}
862
863sub addresses_regex() {
864    return $AddrRegex;
865}
866
867sub msgdbfile() {
868    return &expand_path($MsgDBFile);
869}
870
871sub msgdbtype() {
872    return $MsgDBType;
873}
874
875sub mbox_style() {
876    return $MBoxStyle;
877}
878
879sub mbox_filter() {
880    return $MboxFilter;
881}
882
883sub nntpservers() {
884    return $NNTPservers;
885}
886
887sub nntphistoryfile() {
888    return &expand_path($NNTPhistory);
889}
890
891sub nntpauthuser() {
892    return $NNTPauthuser;
893}
894
895sub set_nntpauthuser($) {
896    $NNTPauthuser = shift;
897}
898
899sub popaccount() {
900    return $POPaccount;
901}
902
903sub pophistoryfile() {
904    return &expand_path($POPhistory);
905}
906
907sub imapaccount() {
908    return $IMAPaccount;
909}
910
911sub smtpaccount() {
912    return $SMTPaccount;
913}
914
915sub httpproxy() {
916    return $HTTPproxy;
917}
918
919sub noproxy() {
920    return $Noproxy;
921}
922
923sub usepwagent() {
924    return $UsePwAgent;
925}
926
927sub pwagentport() {
928    return $PwAgentPort;
929}
930
931sub pwagent_tmp_dir() {
932    return $PwAgentTmpDir;
933}
934
935sub pwagent_tmp_path() {
936    return expand_path(pwagent_tmp_dir());
937}
938
939sub usepwfiles() {
940    return $UsePwFiles;
941}
942
943sub pwfiles() {
944    return $PwFiles;
945}
946
947sub use_xdispatcher() {
948    return $UseXDispatcher;
949}
950
951sub usetouchfile() {
952    return $UseTouchFile;
953}
954
955sub touchfile() {
956    return $TouchFile;
957}
958
959sub pop_timeout() {
960    return $PopTimeout;
961}
962
963sub imap_timeout() {
964    return $ImapTimeout;
965}
966
967sub nntp_timeout() {
968    return $NntpTimeout;
969}
970
971sub dns_timeout() {
972    return $DnsTimeout;
973}
974
975sub connect_timeout() {
976    return $ConnectTimeout;
977}
978
979sub command_timeout() {
980    return $CommandTimeout;
981}
982
983sub rcv_buf_siz() {
984    return $RcvBufSiz;
985}
986
987sub db_type() {
988    return $IM_DB_TYPE;
989}
990
991sub ssh_path() {
992    return $SshPath || $SSH_PATH;
993}
994
995sub namazuv2() {
996    return $NamazuV2;
997}
998
999sub namazu_dir() {
1000    return $NamazuDir;
1001}
1002
1003sub namazu_path() {
1004    return expand_home(namazu_dir());
1005}
1006
1007sub mknmz_options() {
1008    return $MknmzOptions;
1009}
1010
1011sub mknmz_include_file() {
1012    return &expand_path($MknmzIncludeFile);
1013}
1014
1015sub mknmz_ignore_folders_regex() {
1016    return $MknmzIgnoreFoldersRegex;
1017}
1018
1019sub namazu_lock_dir() {
1020    return $NamazuLockDir;
1021}
1022
1023sub namazu_lock_path() {
1024    return expand_path(namazu_lock_dir());
1025}
1026
1027###
1028### path expansion
1029###
1030
1031sub expand_home($) {
1032    my $folder = shift;
1033
1034    return '' if ($folder eq '');
1035    if ($folder =~ /^\//) {
1036	# nothing
1037    } elsif ($folder =~ /^[a-zA-Z]:\//) {
1038	# nothing
1039    } elsif ($folder =~ /^\~\/(.*)/) {
1040	$folder = home_dir() . '/' . $1;
1041    } else {
1042	$folder = home_dir() . '/' . $folder;
1043    }
1044    return $folder;
1045}
1046
1047sub expand_path($) {
1048    my $folder = shift;
1049
1050    $folder =~ s/^\s*(.*?)\s*$/$1/; # SPC may be used in folder names
1051    return '' unless $folder;
1052
1053    if ($folder =~ /^\//) {
1054	# nothing
1055    } elsif ($folder eq '.') {
1056	$folder = current_dir();
1057    } elsif ($folder eq '..') {
1058	$folder = current_dir() . '/..';
1059    } elsif ($folder =~ /^\.\//) {
1060	$folder = current_dir() . '/' . $folder;
1061    } elsif ($folder =~ /^-/) {
1062	$folder = '';
1063    } elsif ($folder =~ /^\%/) {
1064	$folder = '';
1065    } elsif ($folder =~ /^\+(.*)/) {
1066	$folder = mail_path() . '/' . $1;
1067    } elsif ($folder =~ /^=(.*)/) {
1068	$folder = $1;
1069	$folder =~ s/\./\//g unless preserve_dot();
1070	$folder = news_path() . '/' . $folder;
1071    } elsif ($folder =~ /^[a-zA-Z]:\//) {
1072	# nothing
1073    } elsif ($folder =~ /^\~\/(.*)/) {
1074	$folder = home_dir() . '/' . $1;
1075    } elsif (&unixp() && $folder =~ /^\~([^\/]+)\/(.*)/) {
1076	$folder = (getpwnam($1))[7] . '/' . $2;
1077    } else {
1078	$folder = conf_dir() . '/' . $folder;
1079    }
1080    return $folder;
1081}
1082
10831;
1084__DATA__
1085##
1086## Default global parameters
1087##
1088MailDir=Mail			# relative to ~/
1089NewsDir=News			# relative to ~/
1090# folders for mail messages
1091InboxFolder=+inbox		# default destination of imget
1092DraftFolder=+draft
1093TrashFolder=+trash		# default destination of message removal in mew
1094# mode for creation
1095FolderMode=0700
1096MsgMode=0600
1097# to keep state of IM commands (CurrentFolder, etc.)
1098ContextFile=Context		# relative to ~/.im/
1099##
1100## Default settings
1101##
1102# folders
1103Src=$InboxFolder		# default source of most commands
1104Imclean.Src=$TrashFolder	# default source for message cleanups
1105Immknmz.Src=			# folders specified by Mail/.folders are used
1106#Imget.dst=$InboxFolder		# default inbox folder
1107Imrm.dst=$TrashFolder		# default trash folder
1108# mail address aliases for imali/imput
1109AddrBookFile=Addrbook		# relative to ~/.im/
1110AliasesFile=Aliases		# relative to ~/.im/
1111#PetnameFile=Petnames		# relative to ~/.im/
1112MailFoldersFile=~/Mail/.folders
1113UseTouchFile=off
1114TouchFile=.mew-touch
1115# imget/imls
1116Form=%+5n %m%d %-14A %S || %b	# default format for scanning
1117Width=80			# default width for scanning
1118JisSafe=on			# escape seq. of JIS char. should be managed
1119Indent=2			# indent step for threading
1120DupCheckTarget=message-id	# Duplicate Check Target
1121				# 'message-id' or 'message-id+subject'
1122ImGrep.DupCheckTarget=none
1123# servers
1124Smtpservers=localhost		# default server for SMTP
1125NntpServers=localhost		# default server for NNTP
1126# imput
1127FccDir=$MailDir
1128QueueDir=queue			# relative to ~/.im/
1129UseXDispatcher=on		# use X-Dispatcher field
1130# imget
1131Imget.Src=local			# default source of imget (local mailbox)
1132PopHistory=pophist-{POPSERVERID}	# to save last state (relative to ~/.im/)
1133NntpHistory=newshist		# to save last state (relative to ~/.im/)
1134# impwagent
1135PwAgentTmpDir=pwagtmp		# temporary directory (relative to ~/.im/)
1136# namazu
1137NamazuV2=yes			# use Namazu version 2 (1.9.x or late)
1138NamazuDir=Namazu		# relative to ~/
1139NamazuLockDir=nmzlock		# lock directory (relative to ~/.im/)
1140#MknmzOptions=--decode-base64	# options for mknmz
1141MknmzIncludeFile=~/Namazu/mknmz-inc.pl	# mknmz -I <file>
1142MknmzIgnoreFoldersRegex=\+(attach|draft|trash|queue|postq|schedule)
1143__END__
1144
1145=head1 NAME
1146
1147IM::Config - confiugration for IM
1148
1149=head1 SYNOPSIS
1150
1151 use IM::Config;
1152
1153Subroutines:
1154read_cfg_selector
1155init_opt
1156read_env read_cfg read_opt
1157set_selector used_selectors
1158sanity_check
1159help
1160home_dir conf_dir
1161mail_dir mail_path news_dir news_path queue_dir queue_path
1162inbox_folder draft_folder trash_folder config_cases config_case_inbox
1163preserve_dot
1164folder_mode msg_mode allowcrlf use_cl no_sync fsync_no preferred_fsync_no
1165addrbook_file aliases_file petname_file mail_folders_file
1166context_file getchksbr_file getsbr_file scansbr_file scan_header_pick
1167address addresses_regex
1168msgdbfile msgdbtype
1169mbox_style mbox_filter
1170nntpservers nntphistoryfile nntpauthuser set_nntpauthuser
1171popaccount pophistoryfile imapaccount smtpaccount httpproxy noproxy
1172usepwagent pwagentport pwagent_tmp_dir pwagent_tmp_path usepwfiles pwfiles
1173expand_path use_xdispatcher usetouchfile touchfile
1174namazuv2 namazu_dir namazu_path namazu_lock_dir namazu_lock_path
1175mknmz_options mknmz_include_file mknmz_ignore_folders_regex
1176pop_timeout imap_timeout nntp_timeout dns_timeout
1177connect_timeout command_timeout rcv_buf_siz
1178db_type file_attr ssh_path
1179
1180=head1 DESCRIPTION
1181
1182The I<IM::Config> module is for configuration of IM.
1183
1184This modules is provided by IM (Internet Message).
1185
1186=head1 COPYRIGHT
1187
1188IM (Internet Message) is copyrighted by IM developing team.
1189You can redistribute it and/or modify it under the modified BSD
1190license.  See the copyright file for more details.
1191
1192=cut
1193
1194### Copyright (C) 1997, 1998, 1999 IM developing team
1195### All rights reserved.
1196###
1197### Redistribution and use in source and binary forms, with or without
1198### modification, are permitted provided that the following conditions
1199### are met:
1200###
1201### 1. Redistributions of source code must retain the above copyright
1202###    notice, this list of conditions and the following disclaimer.
1203### 2. Redistributions in binary form must reproduce the above copyright
1204###    notice, this list of conditions and the following disclaimer in the
1205###    documentation and/or other materials provided with the distribution.
1206### 3. Neither the name of the team nor the names of its contributors
1207###    may be used to endorse or promote products derived from this software
1208###    without specific prior written permission.
1209###
1210### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
1211### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
1212### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
1213### PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
1214### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
1215### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
1216### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
1217### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
1218### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
1219### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
1220### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1221