#!/usr/bin/perl
#################################################################
#                                                               #
# Open WebMail - Provides a web interface to user mailboxes     #
#                                                               #
# Copyright (C) 2001-2003                                       #
# The Open Webmail Team                                         #
#                                                               #
# Copyright (C) 2000                                            #
# Ernie Miller  (original GPL project: Neomail)                 #
#                                                               #
# This program is distributed under GNU General Public License  #
#                                                               #
#################################################################

#
# openwebmail.pl - entry point of openwebmail
#
use vars qw($SCRIPT_DIR);
if ( $0 =~ m!^(\S*)/[\w\d\-\.]+\.pl! ) { $SCRIPT_DIR=$1 }
if (!$SCRIPT_DIR && open(F, '/var/www/conf/openwebmail/openwebmail_path.conf')) {
   $_=<F>; close(F); if ( $_=~/^(\S*)/) { $SCRIPT_DIR=$1 }
}
if (!$SCRIPT_DIR) { print "Content-type: text/html\n\nSCRIPT_DIR not set in /var/www/conf/openwebmail/openwebmail_path.conf !\n"; exit 0; }
push (@INC, $SCRIPT_DIR);

foreach (qw(PATH ENV BASH_ENV CDPATH IFS TERM)) { $ENV{$_}='' }	# secure ENV
umask(0002); # make sure the openwebmail group can write

use strict;
use Fcntl qw(:DEFAULT :flock);
use CGI qw(-private_tempfiles :standard);
use CGI::Carp qw(fatalsToBrowser carpout);
use Socket;	# for gethostbyaddr() in ip2hostname
use MIME::Base64;

require "modules/datetime.pl";
require "modules/lang.pl";
require "modules/dbm.pl";
require "modules/filelock.pl";
require "modules/tool.pl";
require "modules/mime.pl";
require "shares/ow-shared.pl";
require "shares/pop3book.pl";
require "shares/upgrade.pl";

# common globals
use vars qw(%config %config_raw);
use vars qw($thissession);
use vars qw($default_logindomain $loginname $logindomain $loginuser);
use vars qw($domain $user $userrealname $uuid $ugid $homedir);
use vars qw(%prefs %style);

# extern vars
use vars qw(@openwebmailrcitem);	# defined in ow-shared.pl
use vars qw(%lang_text %lang_err);	# defined in lang/xy

########## MAIN ##################################################
openwebmail_requestbegin();
$SIG{PIPE}=\&openwebmail_exit;	# for user stop
$SIG{TERM}=\&openwebmail_exit;	# for user stop

load_owconf(\%config_raw, "/var/www/conf/openwebmail/openwebmail.conf.default");
read_owconf(\%config, \%config_raw, "/var/www/conf/openwebmail/openwebmail.conf") if (-f "/var/www/conf/openwebmail/openwebmail.conf");
loadlang($config{'default_language'});	# so %lang... can be used in error msg

# check & create mapping table for solar/lunar, b2g, g2b convertion
foreach my $table ('b2g', 'g2b', 'lunar') {
   if ( $config{$table.'_map'} && !ow::dbm::exist("$config{'ow_etcdir'}/$table")) {
      print qq|Content-type: text/html\n\n|.
            qq|Please execute '$config{'ow_cgidir'}/openwebmail-tool.pl --init' on server first!|;
      openwebmail_exit(0);
   }
}

if ($config{'logfile'}) {
   my $mailgid=getgrnam('mail');
   my ($fmode, $fuid, $fgid) = (stat($config{'logfile'}))[2,4,5];
   if ( !($fmode & 0100000) ) {
      open (LOGFILE,">>$config{'logfile'}") or
         openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $lang_text{'file'} $config{'logfile'}! ($!)");
      close(LOGFILE);
   }
   chmod(0660, $config{'logfile'}) if (($fmode&0660)!=0660);
   chown($>, $mailgid, $config{'logfile'}) if ($fuid!=$>||$fgid!=$mailgid);
}

if ( $config{'forced_ssl_login'} &&	# check the forced use of SSL
     !($ENV{'HTTPS'}=~/on/i||$ENV{'SERVER_PORT'}==443) ) {
   my ($start_url, $refresh, $js);
   $start_url=$config{'start_url'};
   $start_url="https://$ENV{'HTTP_HOST'}$start_url" if ($start_url!~s!^https?://!https://!i);
   if ($ENV{'HTTP_USER_AGENT'}!~/MSIE.+Mac/) {
      # reload page with Refresh header only if not MSIE on Mac
      $refresh=qq|<meta http-equiv="refresh" content="5;URL=$start_url">|;
   } else {
      # reload page with java script if MSIE on Mac
      $js=qq|<script language="JavaScript">\n<!--\n|.
          qq|setTimeout("window.location.href='$start_url'", 5000);\n|.
          qq|//-->\n</script>|;
   }
   print qq|Content-type: text/html\n\n|.
         qq|<html><head>$refresh</head><body>\n|.
         qq|Service is available over SSL only,<br>\n|.
         qq|you will be redirected to <a href="$start_url">SSL login</a> page in 5 seconds...\n|.
         qq|$js\n|.
         qq|</body></html>\n|;
   openwebmail_exit(0);
}

if ( param('loginname') && param('password') ) {
   login();
} else {
   loginmenu();	# display login page if no login
}

openwebmail_requestend();
########## END MAIN ##############################################

########## LOGINMENU #############################################
sub loginmenu {
   $logindomain=param('logindomain')||lc($ENV{'HTTP_HOST'});
   $logindomain=~s/:\d+$//;	# remove port number
   $logindomain=lc(safedomainname($logindomain));
   $logindomain=$config{'domainname_equiv'}{'map'}{$logindomain} if (defined($config{'domainname_equiv'}{'map'}{$logindomain}));
   if (!is_serverdomain_allowed($logindomain)) {
      openwebmailerror(__FILE__, __LINE__, "Service is not available for domain  '$logindomain'");
   }

   read_owconf(\%config, \%config_raw, "$config{'ow_sitesconfdir'}/$logindomain") if ( -f "$config{'ow_sitesconfdir'}/$logindomain");
   if ( $>!=0 &&	# setuid is required if spool is located in system dir
       ($config{'mailspooldir'} eq "/var/mail" ||
        $config{'mailspooldir'} eq "/var/spool/mail")) {
      print "Content-type: text/html\n\n'$0' must setuid to root"; openwebmail_exit(0);
   }

   %prefs = readprefs();
   %style = readstyle($prefs{'style'});
   loadlang($prefs{'language'});

   my ($html, $temphtml);
   $html = applystyle(readtemplate("login.template"));

   $temphtml = startform(-action=>"$config{'ow_cgiurl'}/openwebmail.pl",
                         -name=>'login');
   if (defined(param('action'))) {
      $temphtml .= ow::tool::hiddens(action=>param('action'));
      $temphtml .= ow::tool::hiddens(to=>param('to')) if (defined(param('to')));
      $temphtml .= ow::tool::hiddens(subject=>param('subject')) if (defined(param('subject')));
   }
   $html =~ s/\@\@\@STARTFORM\@\@\@/$temphtml/;

   $temphtml = textfield(-name=>'loginname',
                         -default=>'',
                         -size=>'12',
                         -onChange=>'focuspwd()',
                         -override=>'1');
   $html =~ s/\@\@\@LOGINNAMEFIELD\@\@\@/$temphtml/;

   $temphtml = password_field(-name=>'password',
                              -default=>'',
                              -size=>'12',
                              -onChange=>'focusloginbutton()',
                              -override=>'1');
   $html =~ s/\@\@\@PASSWORDFIELD\@\@\@/$temphtml/;

   if ( $ENV{'HTTP_ACCEPT_ENCODING'}=~/\bgzip\b/ && ow::tool::has_zlib() ) {
      $temphtml = checkbox(-name=>'httpcompress',
                           -value=>'1',
                           -checked=>cookie("openwebmail-httpcompress")||0,
                           -onClick=>'httpcompresshelp()',
                           -label=>'');
   } else {
      $temphtml = checkbox(-name=>'httpcompress',
                           -value=>'1',
                           -checked=>0,
                           -disabled=>1,
                           -label=>'');
   }
   $html =~ s/\@\@\@HTTPCOMPRESSIONCHECKBOX\@\@\@/$temphtml/;

   if ( $#{$config{'domainnames'}} >0 && $config{'enable_domainselectmenu'} ) {
      templateblock_enable($html, 'DOMAIN');
      $temphtml = popup_menu(-name=>'logindomain',
                             -default=>$logindomain,
                             -values=>[@{$config{'domainselmenu_list'}}] );
      $html =~ s/\@\@\@DOMAINMENU\@\@\@/$temphtml/;
   } else {
      $temphtml = ow::tool::hiddens(logindomain=>param('logindomain')||'');
      templateblock_disable($html, 'DOMAIN', $temphtml);
   }

   $temphtml = submit(-name =>"loginbutton",
		      -value=>$lang_text{'login'} );
   $html =~ s/\@\@\@LOGINBUTTON\@\@\@/$temphtml/;
   $temphtml = reset("$lang_text{'clear'}");
   $html =~ s/\@\@\@CLEARBUTTON\@\@\@/$temphtml/;
   $temphtml = end_form();
   $html =~ s/\@\@\@ENDFORM\@\@\@/$temphtml/;

   # undef env to prevent httpprint() doing compression on login page
   undef $ENV{'HTTP_ACCEPT_ENCODING'};
   httpprint([], [htmlheader(), $html, htmlfooter(1)]);
}
########## END LOGINMENU #########################################

########## LOGIN #################################################
sub login {
   $loginname=param('loginname')||'';
   $default_logindomain=param('logindomain')||'';

   ($logindomain, $loginuser)=login_name2domainuser($loginname, $default_logindomain);
   if (!is_serverdomain_allowed($logindomain)) {
      openwebmailerror(__FILE__, __LINE__, "Service is not available for domain  '$logindomain'");
   }

   if (!is_localuser("$loginuser\@$logindomain") && -f "$config{'ow_sitesconfdir'}/$logindomain") {
      read_owconf(\%config, \%config_raw, "$config{'ow_sitesconfdir'}/$logindomain");
   }
   if ( $>!=0 &&	# setuid is required if spool is located in system dir
       ($config{'mailspooldir'} eq "/var/mail" ||
        $config{'mailspooldir'} eq "/var/spool/mail")) {
      print "Content-type: text/html\n\n'$0' must setuid to root"; openwebmail_exit(0);
   }
   loadauth($config{'auth_module'});

   # create domain logfile
   if ($config{'logfile'}) {
      my $mailgid=getgrnam('mail');
      my ($fmode, $fuid, $fgid) = (stat($config{'logfile'}))[2,4,5];
      if ( !($fmode & 0100000) ) {
         open (LOGFILE,">>$config{'logfile'}") or
            openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $lang_text{'file'} $config{'logfile'}! ($!)");
         close(LOGFILE);
      }
      chmod(0660, $config{'logfile'}) if (($fmode&0660)!=0660);
      chown($>, $mailgid, $config{'logfile'}) if ($fuid!=$>||$fgid!=$mailgid);
   }

   update_virtuserdb();	# update index db of virtusertable

   %prefs = readprefs();
   %style = readstyle($prefs{'style'});
   loadlang($prefs{'language'});

   ($domain, $user, $userrealname, $uuid, $ugid, $homedir)
				=get_domain_user_userinfo($logindomain, $loginuser);
   if ($user eq "") {
      sleep $config{'loginerrordelay'};	# delayed response
      writelog("login error - no such user - loginname=$loginname");
      # show 'pwd incorrect' instead of 'user not exist' for better security
      my $html = applystyle(readtemplate("loginfailed.template"));
      $html =~ s/\@\@\@ERRORMSG\@\@\@/$lang_err{'pwd_incorrect'}/;
      httpprint([], [htmlheader(), $html, htmlfooter(1)]);
      return;
   }
   if (! $config{'enable_rootlogin'}) {
      if ($user eq 'root' || $uuid==0) {
         sleep $config{'loginerrordelay'};	# delayed response
         writelog("login error - root login attempt");
         my $html = applystyle(readtemplate("loginfailed.template"));
         $html =~ s/\@\@\@ERRORMSG\@\@\@/$lang_err{'norootlogin'}/;
         httpprint([], [htmlheader(), $html, htmlfooter(1)]);
         return;
      }
   }

   my $userconf="$config{'ow_usersconfdir'}/$user";
   $userconf="$config{'ow_usersconfdir'}/$domain/$user" if ($config{'auth_withdomain'});
   read_owconf(\%config, \%config_raw, "$userconf") if ( -f "$userconf");

   # valid server domain
   if (!is_serverdomain_allowed($logindomain)) {
      openwebmailerror(__FILE__, __LINE__, "Service is not available for $loginuser at '$logindomain'");
   }
   # validate client ip
   my $clientip=ow::tool::clientip();
   if ($#{$config{'allowed_clientip'}}>=0) {
      my $allowed=0;
      foreach my $token (@{$config{'allowed_clientip'}}) {
         if (lc($token) eq 'all' || $clientip=~/^\Q$token\E/) {
            $allowed=1; last;
         } elsif (lc($token) eq 'none') {
            last;
         }
      }
      if (!$allowed) {
         openwebmailerror(__FILE__, __LINE__, $lang_err{'disallowed_client'}." ( ip:$clientip )");
      }
   }
   # validate client domain
   if ($#{$config{'allowed_clientdomain'}}>=0) {
      my $clientdomain;
      my $allowed=0;
      foreach my $token (@{$config{'allowed_clientdomain'}}) {
         if (lc($token) eq 'all') {
            $allowed=1; last;
         } elsif (lc($token) eq 'none') {
            last;
         }
         $clientdomain=ip2hostname($clientip) if ($clientdomain eq "");
         if ($clientdomain=~/\Q$token\E$/ || # matched
             $clientdomain!~/\./) { 		# shortname in /etc/hosts
            $allowed=1; last;
         }
      }
      if (!$allowed) {
         openwebmailerror(__FILE__, __LINE__, $lang_err{'disallowed_client'}." ( hotname:$clientdomain )");
      }
   }

   my $owuserdir = ow::tool::untaint("$config{'ow_usersdir'}/".($config{'auth_withdomain'}?"$domain/$user":$user));
   $homedir = $owuserdir if ( !$config{'use_syshomedir'} );

   $user=ow::tool::untaint($user);
   $uuid=ow::tool::untaint($uuid);
   $ugid=ow::tool::untaint($ugid);
   $homedir=ow::tool::untaint($homedir);

   # create domainhome for stuff not put in syshomedir
   if (!$config{'use_syshomedir'} || !$config{'use_syshomedir_for_dotdir'}) {
      if ($config{'auth_withdomain'}) {
         my $domainhome=ow::tool::untaint("$config{'ow_usersdir'}/$domain");
         if (!-d $domainhome) {
            mkdir($domainhome, 0750);
            openwebmailerror(__FILE__, __LINE__, "Couldn't create domain homedir $domainhome") if (! -d $domainhome);
            my $mailgid=getgrnam('mail');
            chown($uuid, $mailgid, $domainhome);
         }
      }
   }
   upgrade_20030323();
   # create owuserdir for stuff not put in syshomedir
   if ( !$config{'use_syshomedir'} || !$config{'use_syshomedir_for_dotdir'} ) {
      if (!-d $owuserdir) {
         if (mkdir ("$owuserdir", oct(700)) && chown($uuid, (split(/\s+/,$ugid))[0], $owuserdir)) {
            writelog("create owuserdir - $owuserdir, uid=$uuid, gid=".(split(/\s+/,$ugid))[0]);
         } else {
            openwebmailerror(__FILE__, __LINE__, "$lang_err{'cant_create_dir'} $owuserdir ($!)");
         }
      }
   }

   my ($errorcode, $errormsg);
   my $password = param('password') || '';
   if ($config{'auth_withdomain'}) {
      ($errorcode, $errormsg)=check_userpassword(\%config, "$user\@$domain", $password);
   } else {
      ($errorcode, $errormsg)=check_userpassword(\%config, $user, $password);
   }
   if ( $errorcode==0 ) {
      # search old alive session and deletes old expired sessionids
      $thissession = search_and_cleanoldsessions(cookie("$user-sessionid"), $uuid);
      if ($thissession eq "") {	# name the new sessionid
         $thissession = $loginname."*".$default_logindomain."-session-".rand();
      }
      $thissession =~ s!\.\.+!!g;  # remove ..
      if ($thissession =~ /^([\w\.\-\%\@]+\*[\w\.\-]*\-session\-0\.\d+)$/) {
         $thissession = $1; # untaint
      } else {
         openwebmailerror(__FILE__, __LINE__, "Session ID $thissession $lang_err{'has_illegal_chars'}");
      }
      writelog("login - $thissession");

      # get user release date
      my $user_releasedate=read_releasedatefile();

      # create the user's syshome directory if necessary.
      # this must be done before changing to the user's uid.
      if (!-d $homedir && $config{'create_syshomedir'}) {
         if (mkdir ("$homedir", oct(700)) && chown($uuid, (split(/\s+/,$ugid))[0], $homedir)) {
            writelog("create homedir - $homedir, uid=$uuid, gid=".(split(/\s+/,$ugid))[0]);
         } else {
            openwebmailerror(__FILE__, __LINE__, "$lang_err{'cant_create_dir'} $homedir ($!)");
         }
      }

      umask(0077);
      if ( $>==0 ) {			# switch to uuid:mailgid if script is setuid root.
         my $mailgid=getgrnam('mail');	# for better compatibility with other mail progs
         set_euid_egids($uuid, $mailgid, split(/\s+/,$ugid));
         if ( $)!~/\b$mailgid\b/) {	# group mail doesn't exist?
            openwebmailerror(__FILE__, __LINE__, "Set effective gid to mail($mailgid) failed!");
         }
      }

      # create folderdir if it doesn't exist
      my $folderdir="$homedir/$config{'homedirfolderdirname'}";
      if (! -d $folderdir ) {
         if (mkdir ($folderdir, 0700)) {
            writelog("create folderdir - $folderdir, euid=$>, egid=$)");
         } else {
            openwebmailerror(__FILE__, __LINE__, "$lang_err{'cant_create_dir'} $folderdir ($!)");
         }
         upgrade_20021218($user_releasedate);
      }

      # create dirs under ~/.openwebmail/
      check_and_create_dotdir(dotpath('/'));

      # create system spool file /var/mail/xxxx
      my $spoolfile=ow::tool::untaint((get_folderpath_folderdb($user, 'INBOX'))[0]);
      if ( ! -f "$spoolfile" ) {
         open (F, ">>$spoolfile"); close(F);
         chown($uuid, (split(/\s+/,$ugid))[0], $spoolfile);
      }

      # create session file
      my $sessioncookie_value;
      if ( -f "$config{'ow_sessionsdir'}/$thissession" ) { # continue an old session?
         $sessioncookie_value = cookie("$user-sessionid");
      } else {						       # a brand new sesion?
         $sessioncookie_value = crypt(rand(),'OW');
      }
      open (SESSION, "> $config{'ow_sessionsdir'}/$thissession") or # create sessionid
         openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $config{'ow_sessionsdir'}/$thissession! ($!)");
      print SESSION $sessioncookie_value, "\n";
      print SESSION ow::tool::clientip(), "\n";
      print SESSION join("\@\@\@", $domain, $user, $userrealname, $uuid, $ugid, $homedir), "\n";
      close (SESSION);
      writehistory("login - $thissession");

      # symbolic link ~/mbox to ~/mail/saved-messages
      if ( $config{'symboliclink_mbox'} &&
           ((lstat("$homedir/mbox"))[2] & 07770000) eq 0100000) { # regular file
         if (ow::filelock::lock("$folderdir/saved-messages", LOCK_EX|LOCK_NB)) {
            writelog("symlink mbox - $homedir/mbox -> $folderdir/saved-messages");

            if (! -f "$folderdir/saved-messages") {
               open(F,">>$folderdir/saved-messages"); close(F);
            }
            rename("$homedir/mbox", "$homedir/mbox.tmp.$$");
            symlink("$folderdir/saved-messages", "$homedir/mbox");

            open(T,"$homedir/mbox.tmp.$$");
            open(F,"+<$folderdir/saved-messages");
            while(<T>) { print F $_; }
            close(F);
            close(T);

            unlink("$homedir/mbox.tmp.$$");
            ow::filelock::lock("$folderdir/saved-messages", LOCK_UN);
         }
      }

      # check if releaseupgrade() is required
      if ($user_releasedate ne "" &&
          $user_releasedate ne $config{'releasedate'}) {
         upgrade_all($user_releasedate);
         update_releasedatefile();
      }
      update_openwebmailrc($user_releasedate);

      # remove stale folder db
      my (@validfolders, $folderusage);
      getfolders(\@validfolders, \$folderusage);
      del_staledb($user, \@validfolders);

      # create authpop3 book if auth_pop3.pl  & getmail_from_pop3_authserver is yes
      if ($config{'auth_module'} eq 'auth_pop3.pl') {
         my $authpop3book=ow::tool::untaint(dotpath('authpop3.book'));

         if ($config{'getmail_from_pop3_authserver'}) {
            my ($pop3host,$pop3port, $pop3user,$pop3passwd, $pop3del,$enable);
            my $login=$user; $login .= "\@$domain" if ($config{'auth_withdomain'});
            if ( -f "$authpop3book") {
                my %accounts;
                readpop3book("$authpop3book", \%accounts);
                ($pop3host,$pop3port, $pop3user,$pop3passwd, ,$pop3del,$enable)
                   =split(/\@\@\@/, $accounts{"$config{'pop3_authserver'}:$config{'pop3_authport'}\@\@\@$login"});
            }

            if ($pop3host ne $config{'pop3_authserver'} ||
                $pop3port ne $config{'pop3_authport'} ||
                $pop3user ne $login ||
                $pop3passwd ne $password ||
                $pop3del ne $config{'delpop3mail_by_default'} ) {
               if ($pop3host ne $config{'pop3_authserver'} ||
                   $pop3port ne $config{'pop3_authport'} ||
                   $pop3user ne $login ) {
                  $enable=1;
               }
               my %accounts;
               $accounts{"$config{'pop3_authserver'}:$config{'pop3_authport'}\@\@\@$login"}
                  ="$config{'pop3_authserver'}\@\@\@$config{'pop3_authport'}\@\@\@$login\@\@\@$password\@\@\@$config{'delpop3mail_by_default'}\@\@\@$enable";
               writepop3book("$authpop3book", \%accounts);
            }
         } else {
            unlink("$authpop3book");
         }
      }

      # set cookie in header and redirect page to openwebmail-main
      my $action=param('action')||'';
      my $refreshurl;
      if ( ! -f dotpath('openwebmailrc') ) {
         $refreshurl="$config{'ow_cgiurl'}/openwebmail-prefs.pl?sessionid=$thissession&action=userfirsttime";
      } elsif ( $action eq 'composemessage' ) {
         my $to=param('to')||'';
         $to =~ s!^mailto\:!!; # IE passes mailto: with mailaddr to mail client
         my $subject=param('subject')||'';
         $refreshurl="$config{'ow_cgiurl'}/openwebmail-send.pl?sessionid=$thissession&action=composemessage&to=$to&subject=$subject";
      } elsif ( $action eq 'calyear' || $action eq 'calmonth' ||
                $action eq 'calweek' || $action eq 'calday' ) {
         $refreshurl="$config{'ow_cgiurl'}/openwebmail-cal.pl?sessionid=$thissession&action=$action";
      } elsif ( $action eq 'showdir' ) {
         $refreshurl="$config{'ow_cgiurl'}/openwebmail-webdisk.pl?sessionid=$thissession&action=$action";
      } elsif ( $action eq 'editfolders' ) {
         $refreshurl="$config{'ow_cgiurl'}/openwebmail-folder.pl?sessionid=$thissession&action=$action";
      } else {
         if ($config{'enable_webmail'}) {
            $refreshurl="$config{'ow_cgiurl'}/openwebmail-main.pl?sessionid=$thissession&action=listmessages_afterlogin";
         } elsif ($config{'enable_calendar'}) {
            $refreshurl="$config{'ow_cgiurl'}/openwebmail-cal.pl?sessionid=$thissession&action=calmonth";
         } elsif ($config{'enable_webdisk'}) {
            $refreshurl="$config{'ow_cgiurl'}/openwebmail-webdisk.pl?sessionid=$thissession&action=showdir";
         } else {
            openwebmailerror(__FILE__, __LINE__, "$lang_err{'all_module_disabled'}, $lang_err{'access_denied'}");
         }
      }

      if ( !$config{'stay_ssl_afterlogin'} &&	# leave SSL
           ($ENV{'HTTPS'}=~/on/i || $ENV{'SERVER_PORT'}==443) ) {
         $refreshurl="http://$ENV{'HTTP_HOST'}$refreshurl" if ($refreshurl!~s!^https?://!http://!i);
      }

      # cookie for openwebmail to verify session, expired if browser closed
      my $cookie1 = cookie( -name  => "$user-sessionid",
                            -value => "$sessioncookie_value",
                            -path  => '/');
      # cookie for other ap to find openwebmail loginname, expired until 1 month later
      my $cookie2 = cookie( -name  => "openwebmail-loginname",
                            -value => "$loginname",
                            -path  => '/',
                            -expires => "+1M" );
      # cookie for httpcompress switch, expired until 1 month later
      my $cookie3 = cookie( -name  => "openwebmail-httpcompress",
                            -value => param('httpcompress')||0,
                            -path  => '/',
                            -expires => "+1M" );
      # cookie for ssl session, expired if not same session
      my $cookie4 = cookie( -name  => "openwebmail-ssl",
                            -value => ($ENV{'HTTPS'}=~/on/i ||
                                       $ENV{'SERVER_PORT'}==443 ||
                                       0),
                            -path  => '/');

      my ($js, $repeatstr)=('', 'no-repeat');
      my @header=(-cookie=>[$cookie1, $cookie2, $cookie3, $cookie4]);
      if ($ENV{'HTTP_USER_AGENT'}!~/MSIE.+Mac/) {
         # reload page with Refresh header only if not MSIE on Mac
         push(@header, -refresh=>"0.1;URL=$refreshurl");
      } else {
         # reload page with java script in 0.1 sec
         $js=qq|<script language="JavaScript">\n<!--\n|.
             qq|setTimeout("window.location.href='$refreshurl'", 100);\n|.
             qq|//-->\n</script>|;
      }
      $repeatstr='repeat' if ($prefs{'bgrepeat'});

      # display copyright. Don't touch it, please.
      httpprint(\@header,
      		[qq|<html>\n|.
		 qq|<head><title>Copyright</title></head>\n|.
		 qq|<body bgcolor="#ffffff" background="$prefs{'bgurl'}">\n|.
		 qq|<style type="text/css"><!--\n|.
		 qq|body {\n|.
                 qq|background-image: url($prefs{'bgurl'});\n|.
                 qq|background-repeat: $repeatstr;\n|.
                 qq|font-family: Arial,Helvetica,sans-serif; font-size: 10pt; font-color: #cccccc\n|.
                 qq|}\n|.
                 qq|A:link    { color: #cccccc; text-decoration: none }\n|.
                 qq|A:visited { color: #cccccc; text-decoration: none }\n|.
                 qq|A:hover   { color: #333333; text-decoration: none }\n|.
		 qq|--></style>\n|.
		 qq|<center><br><br><br>\n|.
		 qq|<a href="$refreshurl" title="click to next page" style="text-decoration: none">|.
		 qq|<font color="#333333"> &nbsp; $lang_text{'loading'} ...</font></a>\n|.
		 qq|<br><br><br>\n\n|.
		 qq|<a href="http://openwebmail.org/" title="click to home of $config{'name'}" target="_blank" style="text-decoration: none">\n|.
		 qq|$config{'name'} $config{'version'} $config{'releasedate'}<br><br>\n|.
		 qq|Copyright (C) 2001-2003<br>\n|.
		 qq|Chung-Kie Tung, Nai-Jung Kuo, Chao-Chiu Wang, Emir Litric,<br>|.
                 qq|Thomas Chung, Dattola Filippo, Bernd Bass, Scott Mazur<br><br>\n|.
		 qq|Copyright (C) 2000<br>\n|.
		 qq|Ernie Miller  (original GPL project: Neomail)<br><br>\n|.
		 qq|</a>\n\n|.
		 qq|<a href="$config{'ow_htmlurl'}/doc/copyright.txt" title="click to see GPL version 2 licence" target="_blank" style="text-decoration: none">\n|.
		 qq|This program is free software; you can redistribute it and/or modify<br>\n|.
		 qq|it under the terms of the version 2 of GNU General Public License<br>\n|.
		 qq|as published by the Free Software Foundation<br><br>\n|.
		 qq|This program is distributed in the hope that it will be useful,<br>\n|.
		 qq|but WITHOUT ANY WARRANTY; without even the implied warranty of<br>\n|.
		 qq|MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.<br>\n|.
		 qq|See the GNU General Public License for more details.<br><br>\n|.
		 qq|Removal or change of this copyright is prohibited.\n|.
		 qq|</a>\n|.
		 qq|$js\n|.
		 qq|</center></body></html>\n|] );

   } else { # Password is INCORRECT
      writelog("login error - $config{'auth_module'}, ret $errorcode, $errormsg");
      umask(0077);
      if ( $>==0 ) {	# switch to uuid:mailgid if script is setuid root.
         my $mailgid=getgrnam('mail');
         set_euid_egids($uuid, $mailgid, split(/\s+/,$ugid));
      }
      my $historyfile=ow::tool::untaint(dotpath('history.log'));
      if (-f $historyfile ) {
         writehistory("login error - $config{'auth_module'}, ret $errorcode, $errormsg");
      }

      my $html = applystyle(readtemplate("loginfailed.template"));

      my $webmsg;
      if ($errorcode==-1) {
         $webmsg=$lang_err{'func_notsupported'};
      } elsif ($errorcode==-2) {
         $webmsg=$lang_err{'param_fmterr'};
      } elsif ($errorcode==-3) {
         $webmsg=$lang_err{'auth_syserr'};
      } elsif ($errorcode==-4) {
         $webmsg=$lang_err{'pwd_incorrect'};
      } else {
         $webmsg="Unknow error code $errorcode";
      }
      $html =~ s/\@\@\@ERRORMSG\@\@\@/$webmsg/;

      sleep $config{'loginerrordelay'};	# delayed response
      httpprint([], [htmlheader(), $html, htmlfooter(1)]);
   }
}

sub ip2hostname {
   my $ip=$_[0];
   my $hostname;
   eval {
      local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
      alarm 10; # timeout 10sec
      $hostname=gethostbyaddr(inet_aton($ip),AF_INET);
      alarm 0;
   };
   return($ip) if ($@);	# eval error, it means timeout
   return($hostname);
}
########## END LOGIN #############################################

########## IS_SERVERDOMAIN_ALLOWED ###############################
sub is_serverdomain_allowed {
   my $domain=$_[0];
   if ($#{$config{'allowed_serverdomain'}}>=0) {
      foreach my $token (@{$config{'allowed_serverdomain'}}) {
         if (lc($token) eq 'all' || lc($domain) eq lc($token)) {
            return 1;
         } elsif (lc($token) eq 'none') {
            return 0;
         }
      }
      return 0;
   } else {
      return 1;
   }
}
########## END IS_SERVERDOMAIN_ALLOWED ###########################

########## SEARCH_AND_CLEANOLDSESSIONS ###########################
# delete expired session files and
# try to find old session that is still valid for the same user cookie
sub search_and_cleanoldsessions {
   my ($oldcookie, $owner_uid)=@_;
   my $oldsessionid="";
   my ($sessionid, $modifyage);
   my @delfiles;

   opendir(SESSIONSDIR, "$config{'ow_sessionsdir'}") or
      openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $config{'ow_sessionsdir'}! ($!)");
   my $t=time();
   while (defined($sessionid = readdir(SESSIONSDIR))) {
      if ($sessionid =~ /^(.+\-session\-0.*)$/) {
         $sessionid = $1;
         $modifyage = $t-(stat("$config{'ow_sessionsdir'}/$sessionid"))[9];

         $sessionid =~ /^([\w\.\-\%\@]+)\*([\w\.\-]*)\-session\-(0\.\d+)$/;
         my ($sess_loginname, $sess_default_logindomain)=($1, $2); # param from sessionid

         if ($loginname eq $sess_loginname &&
             $default_logindomain eq $sess_default_logindomain) {
            # remove user old session if timeout
            if ( $modifyage > $prefs{'sessiontimeout'}*60 ) {
               writelog("session cleanup - $sessionid");
               push(@delfiles, "$config{'ow_sessionsdir'}/$sessionid");
            } else {
               my ($cookie, $ip, $userinfo)=sessioninfo($sessionid);
               if ($oldcookie && $cookie eq $oldcookie && $ip eq ow::tool::clientip() &&
                   (stat("$config{'ow_sessionsdir'}/$sessionid"))[4] == $owner_uid ) {
                  $oldsessionid=$sessionid;
               } elsif (!$config{'session_multilogin'}) { # remove old session of this user
                  writelog("session cleanup - $sessionid");
                  push(@delfiles, "$config{'ow_sessionsdir'}/$sessionid");
               }
            }
         } else {	# remove old session of other user if more than 1 day
            if ( $modifyage > 86400 ) {
               writelog("session cleanup - $sessionid");
               push(@delfiles, "$config{'ow_sessionsdir'}/$sessionid");
            }
         }
      }
   }
   closedir(SESSIONSDIR);

   unlink(@delfiles) if ($#delfiles>=0);
   return($oldsessionid);
}
########## END SEARCH_AND_CLEANOLDSESSIONS #######################

########## UPDATE_OPENWEBMAILRC ##################################
sub update_openwebmailrc {
   my $user_releasedate=$_[0];

   my $rcfile=dotpath('openwebmailrc');
   my $saverc=0;
   if (-f $rcfile) {
      $saverc=1 if ( $user_releasedate lt "20031214" );	# rc upgrade
      %prefs = readprefs() if ($saverc);		# load user old prefs + sys defaults
   } else {
      $saverc=1 if ($config{'auto_createrc'});		# rc auto create
   }
   if ($saverc) {
      open (RC, ">$rcfile") or
         openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $rcfile! ($!)");
      foreach my $key (@openwebmailrcitem) {
         print RC "$key=$prefs{$key}\n";
      }
      close (RC) or openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_close'} $rcfile!");
   }
   return;
}
########## END UPDATE_OPENWEBMAILRC ##############################
