im 1:151-3 / usr / bin / imsetup

#! /usr/bin/perl
################################################################
###
###		    imsetup: setup command for IM
###
### Author:  Internet Message Group <img@mew.org>
### Created: May  9, 1997
### Revised: Feb 15, 2010
###

BEGIN {
    use lib '/usr/share/perl5';
};

$Prog = 'imsetup';
my $VERSION_DATE = "20110525";
my $VERSION_NUMBER = "151";
my $VERSION = "${Prog} version ${VERSION_DATE}(IM${VERSION_NUMBER})";
my $VERSION_INFORMATION = "${Prog} (IM ${VERSION_NUMBER}) ${VERSION_DATE}
Copyright (C) 1999 IM developing team
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
";

##
## Require packages
##

use File::Copy;
use Sys::Hostname;
use IM::Config qw(init_opt read_opt read_cfg use_cl no_sync help);
use IM::Util;
use IM::Address qw(extract_addr);
use integer;
use strict;
use vars qw($Prog $EXPLANATION @OptConfig
	    $opt_fromdomain $opt_noharm $opt_usecl $opt_nosync
	    $opt_help $opt_version);

##
## Environments
##

my $imdir = ".im";
my $config = "Config";
my $alias = "Aliases";

my $home = $ENV{'HOME'};
my $address;
my $username;
my $mail = "Mail";
my $news = "News";
my $usecl;
my $nosync;
my $src = "local";
my $mailbox_style = "mbox";
my $auth = "";
my($user, $host) = split(/\@/, $address);
my $keep = 0;
my $smtpserver = "localhost";

my($mhdir, $mhalias, $domain, $nntpservers);

$EXPLANATION = "$VERSION
setup for IM

Usage: $Prog [Options]
";

@OptConfig = (
    'FromDomain;s;;' => 'Default domain name for mail address',
    'noharm;b;;' => "Do execute setup, show what will be performed",
    'help;b;;'    => "Display this help and exit",
    'version,V;b;;' => "Output version information and exit",
    );

##
## Profile and option processing
##

init_opt(\@OptConfig);
read_cfg();
read_opt(\@ARGV); # help?
print("${VERSION_INFORMATION}") && exit $EXIT_SUCCESS if $opt_version;
help($EXPLANATION) && exit $EXIT_SUCCESS if $opt_help;

##
## Main
##

if ($opt_fromdomain =~ /\./) {
    $address = im_getlogin() . "\@" . $opt_fromdomain;
} else {
    $address = im_getlogin() . "\@" . get_domain_name();
}
$usecl = use_cl() ? 'yes' : 'no';
$nosync = no_sync() ? 'yes' : 'no';

&read_conf();
&check_im_directory();
&make_conf_file();
&copy_alias_file();

sub get_domain_name() {
    my $hostname = hostname();
    unless ($hostname =~ /\./) {
	my($h) = gethostbyname($hostname);
	$hostname = $h if ($h);
    }
    $hostname =~ s/^[^.]+\.//;

    return $hostname;
}

sub read_conf() {
    $home = &input_config("Where is your home directory?", $home);
    &scan_mh_conf();

    my $mymail = "$home/$mail";
    my $mynews = "$home/$news";
    my $qhome = quotemeta($home);

    do {
	do {
	    $mymail = &input_config("Where is your Mail directory?", $mymail);
	} until (($mail = $mymail) =~ s!^$qhome/!!
		 || &input_confirm("Sure to use $mail which is not beneath "
				   . "your home directory?"));
    } while (! &check_and_create_directory($mymail));

    do {
	do {
	    $mynews = &input_config("Where is your News directory?", $mynews);
	} until (($news = $mynews) =~ s!^$qhome/!!
		 || &input_confirm("Sure to use $news which is not beneath "
				   . "your home directory?"));
    } while (! &check_and_create_directory($mynews));

    $address = &input_config("What is your E-mail address(es)?", $address);

    do {
        $src = &input_config("What kind of mail spool do you use? (local/POP/IMAP)", $src);
    } while (! ($src =~ /^local$|^pop$|^imap$/i));
  
    if ($src =~ /^local/i) {
	do {
	    $mailbox_style = &input_config("What kind of mailbox style do you use? (mbox/maildir)", $mailbox_style);
	} while (! ($mailbox_style =~ /^mbox$|^maildir$/i));
    }

    if ($src =~ /^pop|^imap/i) {
        my $a = extract_addr($address);
        if ($src =~ /^pop/i) {
            $auth = "POP";
            do {
                $auth = &input_config("What kind of POP authentication mechanism? (POP/APOP/RPOP)", $auth);
            } while (! ($auth =~ /^pop$|^apop$|^rpop$/i));
        } else {
            $auth = "AUTH";
            do {
                $auth = &input_config("What kind of IMAP authentication mechanism? (AUTH/LOGIN)", $auth);
            } while (! ($auth =~ /^auth$|^login$/i));
        }
        ($user, $host) = split(/\@/, $a);
        $host = "mail." . $host;
        $user = &input_config("What is your $src account name?", $user);
        $host = &input_config("What is your $src server name or IP address?", $host);

    } 

    if ($src =~ /^pop/i) {
	$keep = &input_config("Do you want to preserve messages?\n"
                        . "0 (delete immediately), -1 (preserve forever),\n"
			. "N > 0 (delete messages after N days) "
			, $keep);
    }

    if ($src =~ /^pop|^imap/i) { $smtpserver = $host; }
    $smtpserver = &input_config("What is your SMTP server name or IP address?", $smtpserver);

    $usecl = &input_config("Do you want to use value of Content-Length"
			   . " header for delimitation for local\nmail?"
			   . " (Answer yes if your OS supports Content-Length"
			   . " header like Solaris 2.x,\notherwise answer no.)"
			   , $usecl);

    if ($nosync ne 'yes') {
	$nosync = 
	    &input_config("Does your system can detect write errors without"
			  . " fsync(2)? (You can answer yes,\n"
			  . "if your home directory is on local file system,"
			  . " otherwise answer no.)"
			  , $nosync eq 'undefined' ? 'no' : $nosync);
    }

    print "\n";
}

sub input_config($$) {
    my($msg, $default) = @_;
    my $ret;

    print "$msg [$default] ";
    chomp($ret = <STDIN>);
    $ret = $default if ($ret =~ /^\s*$/);
    return $ret;
}

sub input_confirm($;$) {
    my($msg, $default) = @_;
    my $ret;

    $default = "yes" if $default eq "";

    print "$msg [$default] ";
    chomp($ret = <STDIN>);
    $ret = $default if ($ret =~ /^\s*$/);
    return $ret =~ m/^y/i;
}

sub scan_mh_conf() {
    my $mh_profile = "$home/.mh_profile";
    if (-f $mh_profile) {
	open(MH_PROFILE, $mh_profile);
	while (<MH_PROFILE>) {
	    chomp;
	    if (/^Path:\s*(.*)/i) {
		$mhdir = $mail =  $1;
		$mail =~ s/($home|~)\///;
	    }
	    if (/^Aliasfile:\s*(.*)/i) {
		$mhalias = $1;
	    }
	    if (!$mhalias && /^ali:\s*-alias\s*(.*)/i) {
		$mhalias = $1;
	    }
	    if (/^Alternate-Mailboxes:\s*(.*)/i) {
		$address = $1;
	    }
	}
    } else {
	$mhdir = $mail;
	$mhalias = 'aliases';
    }
}

sub check_im_directory() {
    if (-x "$home/$imdir") {
	print "$home/$imdir is already exist.\n";
    } else {
	if (!$opt_noharm) {
	    if (mkdir("$home/$imdir", 0700) == 0) {
		die "Fail to create $home/$imdir directory: $!\n";
	    }
	    print "Directory $home/$imdir created.\n";
	}
    }
}

sub check_and_create_directory($) {
    my $dir = shift;

    if (! -x $dir) {
	if (&input_confirm("$dir does not exist. Create it?")) {
	    print "Creating $dir directory.\n";
	    if (!$opt_noharm) {
		if (mkdir("$dir", 0700) == 0) {
		    die "Fail to create $dir directory: $!\n";
		}
		print "Directory $dir created.\n";
	    }
	    return 1;
	}
	else {
	    return 0;
	}
    }
    return 1;
}

sub copy_alias_file() {
    my $im_alias = "$home/$imdir/$alias";
    my $mh_alias = "$home/$mhdir/$mhalias";

    if (! -f $mh_alias) {
	$mh_alias = $mhalias;
    }

    if (-f $mh_alias && ! -f $im_alias) {
	print "Copy $mh_alias to $im_alias.\n";
	if (!$opt_noharm) {
	    copy($mh_alias, $im_alias);
	}
    }
}

sub make_conf_file() {
    my $im_config = "$home/$imdir/$config";

    if (-f $im_config) {
	print "Backup $im_config to $im_config.bak.\n";
	if (!$opt_noharm) {
	    rename ("$im_config", "$im_config.bak");
	}
    }

    print "Setup $im_config.\n";
    if (!$opt_noharm) {
	my $a = extract_addr($address);
	($username, $domain) = split(/\@/, $a);
	$nntpservers = $ENV{'NNTPSERVER'} || "localhost";
	open(CONFIG, ">$im_config");
	print CONFIG <<"---";
################################################################
###
### Sample ~/.im/Config
###
### Syntax::
###	key=value
###
###  * "key=value" is equivalent to "--key=value" style command option.
###  * "key" must start at the beginning of the line.
###  * "=" must follow after "key" without white spaces.
###  * White spaces are allowed between "=" and "value".
###  * ":" can be used instead of "=".
###  * Characters after "#" are ignored.
###
### The following examples are all the same:
###	key=value
###	key=  value
###	key:value
###     key:  value
###
### \$variable will be expanded.
### '~' will be expanded.
###

##
## Individual information
##

Address=$address
FromDomain=$domain
ToDomain=$domain
#Name=Full Name			# commentary name for my mail address
				# should not contain 8bit characters
#AddrRegex=
#Org=The Mew Organization	# for news posting
User=$username

##
## Default global parameters
##

### Directories (relative to ~/)
MailDir=$mail
NewsDir=$news			# for saved news

### Folders in \$MailDir
#InboxFolder=+inbox		# default destination of imget
#DraftFolder=+draft
#TrashFolder=+trash		# default destination of message removal in Mew

### Folder style in \$NewsDir (saved news articles)
#PreserveDot=off		# off: /news/group/, on: /news.group/

### Mode for creation
#FolderMode=0700
#MsgMode=0600

### To keep state of IM commands (CurrentFolder, etc.)
#ContextFile=Context		# relative to ~/.im/


##
## Default settings
##

## Address Book
#AddrBookFile=Addrbook		# relative to ~/.im/
#AddrBookFile=\${HOME}/Mail/Addrbook	# if you share Addrbook with Mew 2
## Mail address aliases
#AliasesFile=Aliases		# relative to ~/.im/
## PetName: mail address aliases for displaying
#PetnameFile=Petnames		# relative to ~/.im/

## Message-ID database
#MsgDBFile=msgiddb		# location (relative to ~/.im/)
#MsgDBType=DB			# type of database (DB, NDBM, SDBM)

## To call user defined subroutines (relative to ~/.im/)
#GetChkSbr=getchk.sbr		# hooks for imget
#GetSbr=get.sbr			# hooks for imget
#ScanSbr=scan.sbr		# hooks for imget/imls

## Working folders
#Src=\$InboxFolder		# default source of most commands
#Imrm.Src=\$TrashFolder		# default source for message cleanups

## imget/imls specific
#ScanSbr=scan.sbr		# hook for special processing (rel. to ~/.im/)
#Form=%+5n %m%d %-14A %S || %b	# default format for scanning
#AllowCRLF=no			# saved messages may contain CRLF (DOS style)
#Width=80			# default width for scanning
#JisSafe=on			# escape seq. of JIS char. should be managed
#Indent=2			# indent step for threading

## Servers
Smtpservers=$smtpserver
#Smtpservers=localhost		# default server for SMTP
#EmgSmtpSvrs=12.34.56.78,localhost	# SMTP server just for error return
#NntpServers=localhost		# default server for NNTP

## imget specific
#GetSbr=get.sbr			# hook for special processing (rel. to ~/.im/)
---

	if ($src =~ /^local/i) {
	    if ($mailbox_style =~ /^maildir/i) {
		print CONFIG <<"---";
MBoxStyle=qmail
Imget.Src=local:\${HOME}/Maildir
keep=$keep
---
	    } else {
		print CONFIG <<"---";
Imget.Src=local
keep=$keep
---
	    }
	}
        print CONFIG <<"---";
#Imget.Src=local		# default source of imget (local mailbox)
#lock=flock			# locking style of local mailbox
#rpath=append			# conversion of UNIX From into Return-Path:
#PopHistory=pophist-{POPSERVERID}	# to save last state (relative to ~/.im/)
#NntpHistory=newshist		# to save last state (relative to ~/.im/)
#MboxFilter=bogofilter -p -M -I	# filter for mbox file
#MboxFilter=spamoracle mark
#MBoxFilter=bsfilter --spam-cutoff 0.85 --pipe --insert-flag --mbox 2>/dev/null
#MBoxStyle=qmail		# in case of qmail (maildir format)
#Imget.Src=local:\${HOME}/Maildir
UseCL=$usecl			# Use value of Content-Length header
NoSync=$nosync			# Do not need fsync(2) on writing file
#FsyncNumber=0			# if 0, system call number of fsync is guessed
#SshPath=/usr/bin/ssh		# Path name of SSH program

---
        if ($src =~ /^pop/i) {
            print CONFIG <<"---";
Imget.Src=pop
PopAccount=/$auth:$user\@$host
keep=$keep
---
        }
        print CONFIG <<"---";
#Imget.Src=pop
#PopAccount=/APOP\@localhost	# account info for POP access
#PopAccount=/APOP:user\@host	# account info with user name
#PopAccount=/APOP:user\@host/110	# account info with user name and port number
#Keep=7				# preserve read messages on server
#ProtoKeep=UIDL			# how to know which message is unread
				# (UIDL, LAST, STATUS, MSGID)
#IgnorePostPet=yes		# leave messages for PostPet on POP server

---
        if ($src =~ /^imap/i) {
            print CONFIG <<"---";
Imget.Src=imap%INBOX
ImapAccount=/$auth:$user\@$host
keep=$keep
---
        }
        print CONFIG <<"---";
#Imget.Src=imap%INBOX
#ImapAccount=/AUTH\@localhost	# account info for IMAP access
#ImapAccount=/AUTH:user\@host	# account info with user name
#HttpProxy=proxy-server:8080	# proxy server for HTTP access
#NoProxy=http://.*my.domain/	# URL regex not to use Proxy server
#UsePwAgent=yes			# use password agent
#PwAgentPort=0			# Port to connect pwagent with TCP/IP
				# 0 to use UNIX domain socket
				# NOTE: non-0 (e.g. 6543) is insecure
				#       on multi-user system
#PwAgentTmpDir=pwagtmp		# temporary directory (relative to ~/.im/)

# be careful on security if you wish to use PwFiles!
#UsePwFiles=yes			# use password files
#PwFiles=password		# password files (relative to ~/.im/)

#MailFoldersFile=~/Mail/.folders

#UseTouchFile=yes		# use time-stamp file
#TouchFile=.mew-touch		# time-stamp file for message folders

#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	# additional options for mknmz
#MknmzIncludeFile=~/Namazu/mknmz-inc.pl	# mknmz -I <file>
#MknmzIgnoreFoldersRegex=\+(attach|draft|trash|queue|postq|schedule)

## imput specific
#FccDir=\$MailDir		# directory for FCC folders
#QueueDir=queue			# directory for to store messages to be sent
#UseXDispatcher=yes		# use X-Dispatcher field
#MsgIdUser=\${USER}		# user part for creation of Message-Id:
#MsgIdDomain=\${HOST}		# if you want to use FQDN of dispatching host
#ObeyMTAdomain=yes		# do not append domainpart to addresses by imput
#NoMsgIdForNews=yes		# do not insert Message-Id: when posting as news
#NewsGMTdate=yes		# use GMT for Date: when posting as news
#UseLines=yes			# generate Lines header line
#JPheader=yes			# encode ISO-2022-JP with RFC2047
#Defcode=EUC			# default code in case no way to judge SJIS/EUCj
#JPconv=yes			# convert SJIS/EUCj to ISO-2022-JP
#NoHdrFolding=yes		# do not fold long header line when encoding
#HdrQEncoding=yes		# use Q-encoding to encode ISO-2022-JP
#NameInComment=yes		# yes: (Full Name) Addr, no: Full Name <Addr>
#Lines=3000			# unit to split a message to partial
#Annotate=yes			# annotate on parent messages (MsgDB required)

# Common operational settings
#Help=no
#Quiet=no
#Noharm=no
#Verbose=no
#Debug=


#case mew
#FromDomain=mew.org

#case queue
#JustQueuing=yes
#Queuing=yes

#case news
#Assoc=	+inbox=nntp:fj.mail.system.sendmail;\\
#	+inbox=nntp:fj.mail
#Count=10

#case default
# -- global setting again --
---
    }
}

__END__

=head1 NAME

imsetup - setup for IM

=head1 SYNOPSIS

B<imsetup> [OPTIONS]

=head1 DESCRIPTION

The I<imsetup> command is a setup program for IM.

This command is provided by IM (Internet Message).

=head1 OPTIONS

=over 5

=item I<-f, --fromdomain=STRING>

Default domain name for mail address.

=item I<-n, --noharm={on,off}>

Do execute setup, show what will be performed.

=item I<-h, --help>

Display help message and exit.

=item I<--version>

Output version information and exit.

=back

=head1 COPYRIGHT

IM (Internet Message) is copyrighted by IM developing team.
You can redistribute it and/or modify it under the modified BSD
license.  See the copyright file for more details.

=cut

### Copyright (C) 1997, 1998, 1999 IM developing team
### All rights reserved.
### 
### Redistribution and use in source and binary forms, with or without
### modification, are permitted provided that the following conditions
### are met:
### 
### 1. Redistributions of source code must retain the above copyright
###    notice, this list of conditions and the following disclaimer.
### 2. Redistributions in binary form must reproduce the above copyright
###    notice, this list of conditions and the following disclaimer in the
###    documentation and/or other materials provided with the distribution.
### 3. Neither the name of the team nor the names of its contributors
###    may be used to endorse or promote products derived from this software
###    without specific prior written permission.
### 
### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
### PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

### Local Variables:
### mode: perl
### End: