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