#!/usr/bin/perl -w # # This perl script provides an administration GUI # to help you administer your email server when using # postfix-style virtual domains with a MySQL database # backend. You can find a tutorial on setting up your # own server at: # http://workaround.org/ispmail.shtml # # You can use this script under the terms of the # GNU GPL (general public license). # # Version 1.0 # Christoph Haas (email@christoph-haas.de) # Configuration my $_sendmail = '/usr/sbin/sendmail'; my $_stylesheet = '/style.css'; my $_vmaildir = '/home/vmail'; # Load the utility class use sqlutil; my $sql = new sqlutil; use CGI; my $cgi = new CGI; my $Q = $cgi->import_names('Q'); my $loginuser = $ENV{'REMOTE_USER'}; die unless -x $_sendmail; # do the real work, but trap any errors eval '&main'; # if an error has occured, log it to stdout if($@) { print "Content-type: text/html\n\n"; print "

FATALER FEHLER:
$@

\n"; print $cgi->end_html; } sub main { die "Nobody logged on..." unless $loginuser; print $cgi->header; print $cgi->start_html( -title=>"Mail-Aliase konfigurieren", -style=>{'src'=>$_stylesheet}, ); #print "
".`env`."
"; $cgi->import_names('Q'); print "

Email configuration

"; if ($Q::action eq 'newpop3') # form: create POP3 account { &action_newpop3; } elsif ($Q::action eq 'newpop32') # action: create POP3 account { &action_newpop32; } elsif ($Q::action eq 'delpop3') # action: delete POP3 account { &action_delpop3; } elsif ($Q::action eq 'newpwpop3') # action: new POP3 password { &action_newpwpop3; } elsif ($Q::action eq 'newforward') # form: create new forwarding { &action_newforward; } elsif ($Q::action eq 'newforward2') # action: create new forwarding { &action_newforward2; } elsif ($Q::action eq 'editforward') # form: change forwarding { &action_editforward; } elsif ($Q::action eq 'delforward') # action: delete forwarding { &action_delforward; } elsif ($Q::action eq 'newcatchall') # formu: new default forwarding { &action_newcatchall; } elsif ($Q::action eq 'newcatchall2') # action: save default forwarding { &action_newcatchall2; } else { &action_overview; } print '

© 2003 Christoph Haas - '; print '"; print "

$domain

\n"; my %pop3boxes = &get_pop3boxes($domain); print "

POP3 accounts

"; if (%pop3boxes) { print ""; print "
User name"; for my $pop3 (sort keys %pop3boxes) { print "
$pop3"; print 'Remove'; print 'Change password'; } print "
"; } print '

Create new POP3 account

'; print "

Email forwardings

"; my %emailforwards = &email_forwards($domain); if (%emailforwards) { print ""; print "'; print '
Email address"; print "will be forwarded to..."; for my $forward (sort keys %emailforwards) { my @printforwards=split(/,/,$emailforwards{$forward}); for $_ ( @printforwards ) { $_ = &nice_emailtarget($_); } print '
'.$forward; print ''.join('
',@printforwards); print '
Delete'; # todo #print 'Change'; } print "
"; } print '

New forwarding

'; # Existing default forwarding? print "

Default forwarding

"; if (my $email_default = &email_default($domain)) { print ""; print "
Email address"; print '
'.&nice_emailtarget(&email_default($domain)); print 'Change'; print "
"; } else { print '

Set default forwarding

'; } print ""; } } # Create new POP3 mailbox - print form sub action_newpop3 { # Security check! Does this domain belong to this user? die "NOT YOUR DOMAIN!" unless &own_domain($Q::domain); print "
"; print "

Create new POP3 mailbox for the Domain $Q::domain

"; print $cgi->startform; $cgi->param('action','newpop32'); print $cgi->hidden('action'); print $cgi->hidden('domain'); print ""; print "
Email address:"; print $cgi->textfield ( -name=>'username', -size=>20, -maxlength=>20 ); print "\@$Q::domain"; print "
"; print $cgi->submit ( -name=>'submit', -value=>'Create' ); print $cgi->endform; print "
"; print '

Back

'; } # Neue POP3-Mailbox anlegen - Postfach in Datenbank eintragen sub action_newpop32 { # Security check... die "NOT YOUR DOMAIN!" unless &own_domain($Q::domain); # Check whether there is already an entry for this email address my $count = $sql->sql_scalar("select count(*) from virtual where email=?", $Q::username.'@'.$Q::domain ); #print "

COUNT $count

"; if ( $count > 0 ) { print "

This email address is already in use. Please choose another one.

"; &action_newpop3; return; } print "
"; # Valid user name? if ( $Q::username !~ /^[\w\.-]+$/ ) { print "

Email address is invalid. Please retry.

"; &action_newpop3; return; } # Create a random password my $passwort = &zufalls_passwort; # Create account in the 'users' table $sql->sql_doit( 'insert into users (email,password,maildir,homedir) values (?,encrypt(?),?,?)', "$Q::username\@$Q::domain", $passwort, "$Q::username\@$Q::domain/", $_vmaildir ); # Create account in the 'virtual' table $sql->sql_doit( 'insert into virtual (email,destination) values (?,?)', "$Q::username\@$Q::domain", "$Q::username\@$Q::domain", ); # Send a welcome mail to this account to get the mailbox created open (MAIL, "|$_sendmail -t") or die; { print MAIL "From: Administrator \n"; print MAIL "To: $Q::username\@$Q::domain\n"; print MAIL "Subject: Welcome to $Q::domain\n"; print MAIL "\n"; print MAIL "Welcome to the domain $Q::domain.\n"; print MAIL "As you can read this email your email program is set up correctly.\n"; print MAIL "If you have any questions please write to postmaster\@$Q::domain.\n", } close MAIL; print "

POP3 account created

"; print ""; print "
Email address:"; print "$Q::username\@$Q::domain"; print "
User name:"; print "$Q::username\@$Q::domain"; print "
Password:"; print "$passwort"; print "
POP3 server:"; print "pop.$Q::domain"; #print "
Web mail access:"; #print "https://ssl.$Q::domain/webmail/webmail"; print "
"; print "

The new email address can now be used.

"; print "
"; print '

Back

'; } # Set new POP3 password sub action_newpwpop3 { # Security check... die "USER?" unless $Q::username; $Q::username=~/\@(.*)$/; die "NOT YOUR DOMAIN!" unless &own_domain($1); print "
"; # Create password my $passwort = &zufalls_passwort; # Create account in 'users' table $sql->sql_doit( 'update users set password=encrypt(?) where email=?', $passwort, $Q::username ); print "

POP3 passwort for $Q::username changed

"; print "

The password for fetching email was changed to '$passwort'.

"; print "
"; print '

Back

'; } # Delete POP3 account sub action_delpop3 { # Security check die "USER?" unless $Q::username; $Q::username=~/\@(.*)$/; die "NOT YOUR DOMAIN!" unless &own_domain($1); print "
"; # Delete account in 'users' table $sql->sql_doit( 'delete from users where email=?', $Q::username ); # Delete account in 'virtual' table $sql->sql_doit( 'delete from virtual where email=?', $Q::username ); print "

POP3 mailbox deleted

"; print "

The email account is no longer accessible. However the email files \n"; print "are still on the server and can be fetched until the account is deleted \n"; print "from the hard disk. If you create a new POP3 account with the same \n"; print "email address the very same emails will be accessible again.

"; print '

Back

'; } # Create new email forwarding - print form sub action_newforward { # Security check... die "NOT YOUR DOMAIN!" unless &own_domain($Q::domain); print "
"; print "

Create new email forwarding for the domain $Q::domain

"; print "

This function allows you to create email addresses that will "; print "automatically forward email to another external email address "; print "or a local POP3 mailbox. You can name more than one target. "; print "Each recipient will receive a copy of the email then. However "; print "you do not need to fill all fields.

"; print $cgi->startform; $cgi->param('action','newforward2'); print $cgi->hidden('action'); print $cgi->hidden('domain'); print ""; print "
Email address:"; print $cgi->textfield ( -name=>'from', -size=>20, -maxlength=>20 ); print "\@$Q::domain"; for ( 1 .. 9 ) { print "
is forwarded to email address ($_):"; print $cgi->textfield ( -name=>'toemail'.$_, -size=>50, -maxlength=>50 ); } #print "
...oder..."; #print "
weiterleiten an POP3-Mailbox:"; #my %pop3boxes = &get_pop3boxes($Q::domain); #my @pop3boxes = keys %pop3boxes; #unshift @pop3boxes, '-'; #print $cgi->popup_menu #( # -name=>'topop3', # -values=>[@pop3boxes] #); print "
"; print $cgi->submit ( -name=>'submit', -value=>'Create' ); print $cgi->endform; print "
"; print '

Back

'; } # Create new email forwarding - create database entry sub action_newforward2 { # Security check die "NOT YOUR DOMAIN!" unless &own_domain($Q::domain); # Check if there is the account already exists my $count = $sql->sql_scalar("select count(*) from virtual where email=?", $Q::from.'@'.$Q::domain ); #print "

COUNT $count

"; if ( $count > 0 ) { print "

This email address is already in use. Please choose another one.

"; &action_newforward; return; } # Valid user name? if ( $Q::from !~ /^[\w\.-]+$/ ) { print "

Email address invalid. Please retry.

"; &action_newforward; return; } # Forwarding given? my @forward; for ( 1 .. 9 ) { my $to = $cgi->param('toemail'.$_); if ( $to && $to !~ /^.+\@.+\...+/ ) { print "

Forwarding address $_ invalid. Please retry.

"; &action_newforward; return; } push @forward,$to if $to; } ##print "

".join(',',@forward)."

"; print "
"; # Eintrag in Tabelle 'virtual' anlegen $sql->sql_doit( 'insert into virtual (email,destination) values (?,?)', $Q::from.'@'.$Q::domain, join( ',' , @forward ) ); print "

Email forwarding created

"; print "

All emails directed to '$Q::from' will now be forwarded to "; print "these recipients:

"; print ""; print "
"; print '

Back

'; } # Delete email forwarding from the database sub action_delforward { # Security check... die "FORWARD?" unless $Q::forward; $Q::forward=~/\@(.*)$/; die "NOT YOUR DOMAIN!" unless &own_domain($1); print "
"; # Create entry in the 'virtual' table $sql->sql_doit( 'delete from virtual where email=?', $Q::forward ); print "

Email forwarding deleted

"; print "

All emails directed to '$Q::forward' will no longer be forwarded.

"; print "
"; print '

Back

'; } # Create new default forwarding sub action_newcatchall { # Security check die "NOT YOUR DOMAIN!" unless &own_domain($Q::domain); print "
"; print "

Set default forwarding for the domain $Q::domain

"; print "

The default forwarding defines who gets emails directed to "; print "this domain if there are no other email addresses specified. "; print "If there is no default forwarding then other mails will be "; print "rejected.

"; print $cgi->startform; $cgi->param('action','newcatchall2'); print $cgi->hidden('action'); print $cgi->hidden('domain'); print ""; print "
Email address:"; print $cgi->textfield ( -name=>'catchall', -size=>50, -maxlength=>50 ); print "
"; print $cgi->submit ( -name=>'submit', -value=>'Save' ); print $cgi->submit ( -name=>'nocatchall', -value=>'Remove' ); print $cgi->endform; print "
"; print '

Back

'; } # Save new default forwarding sub action_newcatchall2 { # Security check die "NOT YOUR DOMAIN!" unless &own_domain($Q::domain); # Remove entry from 'virtual' table $sql->sql_doit( 'delete from virtual where email=?', '@'.$Q::domain ); if ( $Q::nocatchall ) { print "
"; print "

Default forwarding for domain $Q::domain removed

"; print "

All emails directed to the '$Q::domain' will be rejected unless "; print "there is a specific email address defined elsewhere.

"; } else { # Invalid user name? if ( $Q::catchall !~ /^.+\@.+\...+/ ) { print "

Email address invalid. Please retry.

"; &action_newcatchall; return; } print "
"; $sql->sql_doit( 'insert into virtual (email,destination) values (?,?)', '@'.$Q::domain, $Q::catchall ); print "

Default forwarding for the domain $Q::domain set

"; print "

All emails directed to the '$Q::domain' will be sent to "; print "'$Q::catchall' unless there is a specific email address "; print "defined elsewhere.

"; } print "
"; print '

Back

'; } # Create new email forwarding - print form sub action_editforward { # Security check die "USER?" unless $Q::forward; $Q::forward=~/\@(.*)$/; die "NOT YOUR DOMAIN!" unless &own_domain($1); print "
"; print "

Change email forwarding $Q::forward

"; print "

This function allows you to create email addresses that will "; print "automatically forward email to another external email address "; print "or a local POP3 mailbox. You can name more than one target. "; print "Each recipient will receive a copy of the email then. However "; print "you do not need to fill all fields.

"; my $qhandle = $sql->sql_query("select * from virtual where email=?", $Q::forward ); my $destinations; if (my $entry = $sql->sql_result($qhandle)) { $destinations = $entry->{destination}; } else { die; } # Pre-set CGI fields with default forwardings my $i=1; for ( split /,/ , $destinations ) { $cgi->param('toemail'.$i , $_); #print "

PUSH $_

"; $i++; } print $cgi->startform; $cgi->param('action','editforward2'); print $cgi->hidden('action'); print $cgi->hidden('domain'); print ""; print "
Email address:"; print $Q::forward; for ( 1 .. 9 ) { print "
will be forwarded to email address ($_):"; print $cgi->textfield ( -name=>'toemail'.$_, -size=>50, -maxlength=>50 ); } print "
"; print $cgi->submit ( -name=>'submit', -value=>'Change' ); print $cgi->endform; print "
"; print '

Back

'; } ###################################################################### ###### # Create a string telling whether the email address is internal or external sub nice_emailtarget { $_ = shift or die; if ( /\@/ ) # =external { return $_; } else # =local { return $_.' (local: '.&user2real($_).')'; } } ###### # Which domains belong to this user? sub get_domains { my $loginuser = shift || die "domains for which user?"; my @domains; my $qhandle = $sql->sql_query("select domain from domains where customer=?",$loginuser); while (my $entry = $sql->sql_result($qhandle)) { push @domains, $entry->{domain}; } return @domains; } ###### # Security check: does this domain belong to the user? sub own_domain { my $domain = shift || die "which domain?"; my $qhandle = $sql->sql_query("select count(*) from domains where customer=? and domain=?",$loginuser,$domain); if (my $entry = $sql->sql_result($qhandle)) { return $entry->{'count(*)'}; } else { die; } } ##### # Which email forwardings are defined? sub email_forwards { my $domain = shift || die "which domains?"; my %forwards; my $qhandle = $sql->sql_query("select * from virtual where email like ?","%\@$domain"); while (my $entry = $sql->sql_result($qhandle)) { $forwards{ $entry->{email} } = $entry->{destination}; #print "

PUSH ".$entry->{email}."

"; } # Remove entries that are no plain forwardings my %pop3boxes = &get_pop3boxes($domain); #print "

POP3BOXES=".join(',',(keys %pop3boxes))."

"; for (keys %forwards) { # Remove default forwarding (@domain.org) if ( /^\@/ ) { delete $forwards{$_}; } # Remove POP3 accounts (that are in the 'users' table) if (defined $pop3boxes{$_}) { delete $forwards{$_}; #print "

DEL POP3 $_

"; } } return %forwards; } ##### # Which default forwardings are there? sub email_default { my $domain = shift || die "which domains?"; my $qhandle = $sql->sql_query("select * from virtual where email=?","\@$domain"); if (my $entry = $sql->sql_result($qhandle)) { return $entry->{destination}; } else { return 0; } } ###### # Which POP3 mailboxes are there (in the 'users' table) sub get_pop3boxes { my $domain = shift || die "email aliases of which domains?"; my %pop3boxes; my $qhandle = $sql->sql_query("select * from users where email like ?","%\@$domain"); while (my $entry = $sql->sql_result($qhandle)) { $pop3boxes{$entry->{email}} = $entry->{name}; } return %pop3boxes; } ###### # Tell real name from local user name sub user2real { return (getpwnam($_[0]))[6]; } ##### # Create random password sub zufalls_passwort { my $password; my $_rand; my $chars = 'abcdeghijklmnopqrtuvwxyzABCDEGHIJKLMNPQRTUVWXYZ-%!$()123456789'; srand; for my $i ( 0 .. 9 ) { $_rand = int(rand(length($chars))); $password .= substr($chars,$_rand,1); } return $password; }