initial commit of file from CVS for e-smith-email on Wed 12 Jul 08:53:55 BST 2023

2023-07-12 08:53:55 +01:00
parent 3e32600b26
commit 7b4659df54
267 changed files with 10708 additions and 2 deletions
--- a/root/usr/lib/systemd/system/smtp-auth-proxy.service
+++ b/root/usr/lib/systemd/system/smtp-auth-proxy.service
@@ -0,0 +1,12 @@
+[Unit]
+Description=Koozali SME Server SMTP auth proxy
+After=network.target remote-fs.target 
+
+[Service]
+Type=simple
+ExecStartPre=/sbin/e-smith/service-status smtp-auth-proxy
+ExecStart=/usr/local/sbin/smtp-auth-proxy.pl
+
+[Install]
+WantedBy=sme-server.target
+
--- a/root/usr/lib/tmpfiles.d/fetchmail.conf
+++ b/root/usr/lib/tmpfiles.d/fetchmail.conf
@@ -0,0 +1 @@
+d /var/lock/fetchmail 0755 qmailr qmail
--- a/root/usr/local/sbin/smtp-auth-proxy.pl
+++ b/root/usr/local/sbin/smtp-auth-proxy.pl
@@ -0,0 +1,174 @@
+#!/usr/bin/perl -w -T
+
+package esmith::SMTPAuthProxy;
+
+use strict;
+use vars qw(@ISA);
+use Net::Server::Fork;
+use Net::SMTP;
+use Net::SMTP::SSL;
+use esmith::ConfigDB;
+
+@ISA = qw(Net::Server::Fork);
+
+
+sub options {
+    my $self = shift;
+    my $prop = $self->{server};
+    my $ref  = shift;
+
+    $self->SUPER::options($ref);
+
+    my $config = esmith::ConfigDB->open_ro || die "Could not open config db";
+    my $smtp_proxy_rec = $config->get('smtp-auth-proxy');
+
+    $prop->{SMTPSmartHost} = $config->get_value('SMTPSmartHost');
+    $prop->{Blacklist} = $smtp_proxy_rec->prop('Blacklist') || " ";
+    $prop->{Userid} = $smtp_proxy_rec->prop('Userid');
+    $prop->{Passwd} = $smtp_proxy_rec->prop('Passwd');
+    $prop->{Debug} = $smtp_proxy_rec->prop('Debug');
+    $prop->{SystemName} = $config->get_value('SystemName');
+    $prop->{DomainName} = $config->get_value('DomainName');
+    $prop->{PeerPort} = $smtp_proxy_rec->prop('PeerPort') || 25;
+    $prop->{Helo} = $config->get('qpsmtpd')->prop('HeloHost') ||
+        "$prop->{SystemName}.$prop->{DomainName}";
+}
+
+esmith::SMTPAuthProxy->run(
+    max_servers => 4,
+    proto => 'tcp',
+    user => 'nobody',
+    group => 'nobody',
+    host => 'localhost',
+    port => 26);
+exit;
+
+### over-ridden subs below
+
+sub process_request
+{
+    my $self = shift;
+    my $kidpid;
+
+    my $smarthost = $self->get_property('SMTPSmartHost');
+    my $port = $self->get_property('PeerPort');
+    my $user = $self->get_property('user');
+    my $domain_name = $self->get_property('DomainName');
+    my $system_name = $self->get_property('SystemName');
+    my $helo = $self->get_property('Helo');
+    my $name = $self->get_property('Userid');
+    my $pass = $self->get_property('Passwd');
+    my $debug = (($self->get_property('Debug') || 'disabled') eq 'enabled')
+                ? 1 : 0;
+    unless ($smarthost && $system_name && $domain_name && $name && $pass)
+    {
+        print "421 Internal error\n";
+        warn "Insufficient configuration for smtp-auth-proxy (SystemName)!\n"
+            unless $system_name;
+        warn "Insufficient configuration for smtp-auth-proxy (DomainName)!\n"
+            unless $domain_name;
+        warn "Insufficient configuration for smtp-auth-proxy (SMTPSmartHost)!\n"
+            unless $smarthost;
+        warn "Insufficient configuration for smtp-auth-proxy (Userid)!\n"
+            unless $name;
+        warn "Insufficient configuration for smtp-auth-proxy (Passwd)!\n"
+            unless $pass;
+        exit;
+    }
+
+    my $class = ($port == 465) ? 'Net::SMTP::SSL' : 'Net::SMTP';
+    my $smtp = $class->new($smarthost,
+                            Hello => $helo,
+                            Debug => $debug,
+                            Port => $port,
+                        );
+    unless ($smtp)
+    {
+        print "451 Upstream SMTP server not available\n";
+        warn "No SMTP connection to server $smarthost on port $port\n";
+        exit;
+    }
+
+    my @ehlo = $smtp->message;
+
+    if (grep { /STARTTLS$/ } @ehlo)
+    {
+        $smtp->command('STARTTLS');
+        my $response = $smtp->response;
+        my $status = $smtp->message;
+        use IO::Socket::SSL;
+        my $sslret = IO::Socket::SSL->start_SSL(
+            $smtp,
+            Timeout            => 30,
+            SSL_startHandshake => 1
+        );
+        unless ($sslret) {
+        my $error = IO::Socket::SSL::errstr();
+            print("454 TLS not available due to temporary reason [$error]");
+        }
+    bless $smtp, 'Net::SMTP::SSL';
+    $smtp->reset;
+    $smtp->hello("${system_name}.${domain_name}");
+    @ehlo = $smtp->message;
+    }
+
+    if ($smtp->supports("AUTH"))
+    {
+        my $authenticated = 0;
+        my $blacklist =  $self->get_property('Blacklist') || "";;
+        foreach my $method (split (/ /, ${*$smtp}{'net_smtp_esmtp'}->{"AUTH"}))
+        {
+            # Skip $method if in the blacklist
+            if ($blacklist =~ /$method/)
+	    {
+		warn "Skipping blacklisted method $method\n" if $debug;
+		next;
+	    }
+	    warn "Trying authentication method $method\n" if $debug;
+            # Only present one auth method at a time to NET::SMTP
+            {${*$smtp}{'net_smtp_esmtp'}->{"AUTH"} = $method;}
+
+	    eval { $authenticated = $smtp->auth($name, $pass); };
+
+	    if ($@)
+	    {
+                warn "exception during authentication (with $method): $@\n";
+		next;
+	    }
+	    last if $authenticated;
+	    warn "SMTP authentication (with $method) with ISP server failed\n";
+        }
+        unless ($authenticated)
+        {
+            print "451 Could not auth to mail server\n";
+            warn "all SMTP authentication methods failed\n";
+            $smtp->quit;
+            exit;
+        }
+    }
+    else
+    {
+        warn "Upstream SMTP server does not support authentication\n";
+    }
+    print "220 ", $smtp->banner;
+
+    my $discard = <STDIN>; # Swallow EHLO
+    while (my $msg = shift @ehlo) {
+    my $sep = (@ehlo ? "-" : " ");
+    print "250$sep$msg";
+  }
+
+    die "can't fork: $!" unless defined ($kidpid = fork());
+    if ($kidpid)
+    {
+        print $smtp $_ while <STDIN>;
+        kill ("TERM" => $kidpid);
+    }
+    else
+    {
+        print while <$smtp>;
+        kill ("TERM" => getppid());
+    }
+}
+
+1;
--- a/root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/emailsettings.pm
+++ b/root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/emailsettings.pm
@@ -0,0 +1,823 @@
+#!/usr/bin/perl -w 
+
+#
+# $Id: emailsettings.pm,v 1.16 2005/09/02 15:14:18 charlieb Exp $
+#
+
+package    esmith::FormMagick::Panel::emailsettings;
+
+use strict;
+use esmith::ConfigDB;
+use esmith::AccountsDB;
+use esmith::FormMagick;
+use esmith::util;
+use File::Basename;
+use Exporter;
+use Carp;
+
+our @ISA = qw(esmith::FormMagick Exporter);
+
+our @EXPORT = qw( fetchmail_frequencies get_secondary_mail_use_envelope
+  change_settings_access change_settings_delivery change_settings_reception
+  blank_or_ip_number
+  get_current_webmail_status validate_smarthost getExtraParams
+  get_current_pop3_access get_current_imap_access get_current_smtp_auth
+  get_prop get_value
+);
+
+our $VERSION = sprintf '%d.%03d', q$Revision: 1.16 $ =~ /: (\d+).(\d+)/;
+
+our $db = esmith::ConfigDB->open;
+our $pattern_db = esmith::ConfigDB->open("mailpatterns");
+
+# {{{ header
+
+=pod 
+
+=head1 NAME
+
+esmith::FormMagick::Panels::emailsettings - merged email panels
+
+=head1 SYNOPSIS
+
+    use esmith::FormMagick::Panels::emailsettings;
+
+    my $panel = esmith::FormMagick::Panel::emailsettings->new();
+    $panel->display();
+
+=head1 DESCRIPTION
+
+=cut
+
+# {{{ new
+
+=head2 new();
+
+Exactly as for esmith::FormMagick
+
+=begin testing
+
+
+use_ok('esmith::FormMagick::Panel::emailsettings');
+use vars qw($panel);
+ok($panel = esmith::FormMagick::Panel::emailsettings->new(), "Create panel object");
+isa_ok($panel, 'esmith::FormMagick::Panel::emailsettings');
+
+=end testing
+
+=cut
+
+sub new {
+    shift;
+    my $self = esmith::FormMagick->new();
+    $self->{calling_package} = (caller)[0];
+    bless $self;
+    return $self;
+}
+
+# }}}
+
+=head2 get_prop ITEM PROP
+
+A simple accessor for esmith::ConfigDB::Record::prop
+
+=cut
+
+sub get_prop 
+{
+    my ($fm, $item, $prop, $default) = @_;
+
+    return $db->get_prop($item, $prop) || $default;
+}
+
+=head2 get_value ITEM
+
+A simple accessor for esmith::ConfigDB::Record::value
+
+=cut
+
+sub get_value 
+{
+    my $fm   = shift;
+    my $item = shift;
+
+    return $db->get_value($item) || '';
+}
+
+=head2 get_emailunknownuser_options
+
+Return a hash of existing system accounts and returntosender
+
+=cut
+
+sub get_emailunknownuser_options {
+    my $fm = shift;
+    my $accounts = esmith::AccountsDB->open_ro();
+    my %existingAccounts = ('admin' => $fm->localise("FORWARD_TO_ADMIN"), 
+            'returntosender' => $fm->localise("RETURN_TO_SENDER") );
+
+    foreach my $account ($accounts->get_all) {
+        next if $account->key eq 'everyone';
+        if ($account->prop('type') =~ /(user|group|pseudonym)/) {
+            $existingAccounts{$account->key} = $fm->localise("FORWARD_TO") . " " . $account->key;
+        }
+    }
+    return(\%existingAccounts); 
+}
+
+sub get_emailunknownuser_status
+{
+    my ($fm, $localise) = @_;
+
+    my $options = $fm->get_emailunknownuser_options();
+
+    my $val = $db->get_value('EmailUnknownUser') || "returntosender";
+
+    return $localise ? $fm->localise($options->{$val}) : $val;
+}
+
+=head2 get_secondary_mail_use_envelope
+
+Returns on or off, based on whether or not the fetchmail "SecondaryMailEnvelope" 
+property is set.
+
+=cut
+
+sub get_secondary_mail_use_envelope {
+
+    my $use_envelope = $db->get_prop('fetchmail', 'SecondaryMailEnvelope');
+    if ( defined $use_envelope ) {
+        return ('on');
+    }
+    else {
+        return ('off');
+    }
+}
+
+=head2 fetchmail_frequencies
+
+  Returns a string of a hash of frequencies to have fetchmail check mail
+
+=cut
+
+sub fetchmail_frequencies {
+
+    my %params = (
+        'never'      => 'NEVER',
+        'every5min'  => 'EVERY5MIN',
+        'every15min' => 'EVERY15MIN',
+        'every30min' => 'EVERY30MIN',
+        'everyhour'  => 'EVERYHOUR',
+        'every2hrs'  => 'EVERY2HRS'
+    );
+
+    return ( \%params );
+}
+
+=head1 ACTION
+
+=head2 change_settings_reception
+
+	If everything has been validated, properly, go ahead and set the new settings
+
+=cut
+
+sub change_settings_reception
+{
+    my ($fm) = @_;
+    my $q = $fm->{'cgi'};
+
+    my $FetchmailMethod = ( $q->param('FetchmailMethod') || 'standard' );
+
+    my $FetchmailFreqOffice = ( $q->param('FreqOffice') || 'every15min' );
+
+    my $FetchmailFreqOutside = ( $q->param('FreqOutside')   || 'everyhour' );
+    my $FetchmailFreqWeekend = ( $q->param('FreqWeekend')   || 'everyhour' );
+    my $SpecifyHeader        = ( $q->param('SpecifyHeader') || 'off' );
+
+    my $fetchmail = $db->get('fetchmail') || $db->new_record( "fetchmail", 
+			{ type => "service", status => "disabled" } );
+
+    if ( $FetchmailMethod eq 'standard' ) {
+        $fetchmail->set_prop( 'status', 'disabled' );
+        $fetchmail->set_prop( 'Method', $FetchmailMethod );
+    }
+    else {
+        $fetchmail->set_prop( 'status', 'enabled' );
+        $fetchmail->set_prop( 'Method', $FetchmailMethod );
+        $fetchmail->set_prop( 'SecondaryMailServer', 
+	    $q->param('SecondaryMailServer') )
+	    unless ( $q->param('SecondaryMailServer') eq '' );
+
+        $fetchmail->set_prop('FreqOffice',  $FetchmailFreqOffice );
+        $fetchmail->set_prop('FreqOutside', $FetchmailFreqOutside );
+        $fetchmail->set_prop('FreqWeekend', $FetchmailFreqWeekend );
+        $fetchmail->set_prop('SecondaryMailAccount',
+	    $q->param('SecondaryMailAccount') )
+	    unless ( $q->param('SecondaryMailAccount') eq '' );
+
+        $fetchmail->set_prop( 'SecondaryMailPassword',
+	    $q->param('SecondaryMailPassword') )
+	    unless ( $q->param('SecondaryMailPassword') eq '' );
+
+        if ( $SpecifyHeader eq 'on' ) {
+            $fetchmail->merge_props(
+                'SecondaryMailEnvelope' => $q->param('SecondaryMailEnvelope') );
+        }
+        else {
+            $fetchmail->delete_prop('SecondaryMailEnvelope');
+        }
+    }
+
+    my $smtpAuth = ($q->param('SMTPAuth') || 'public');
+    if ($smtpAuth eq 'public') {
+        $db->set_prop("qpsmtpd", "Authentication", "enabled" );
+        $db->set_prop("sqpsmtpd", "Authentication", "enabled" );
+    } elsif ($smtpAuth eq 'publicSSL') {
+        $db->set_prop("qpsmtpd", "Authentication", "disabled" );
+        $db->set_prop("sqpsmtpd", "Authentication", "enabled" );
+    } else {
+        $db->set_prop("qpsmtpd", "Authentication", "disabled" );
+        $db->set_prop("sqpsmtpd", "Authentication", "disabled" );
+    }
+
+    unless ( system( "/sbin/e-smith/signal-event", "email-update" ) == 0 )
+    {
+	$fm->error('ERROR_UPDATING_CONFIGURATION');
+	return undef;
+    }
+    $fm->success('SUCCESS');
+}
+
+sub change_settings_delivery
+{
+    my ($fm) = @_;
+    my $q = $fm->{'cgi'};
+
+    my $EmailUnknownUser = ($q->param('EmailUnknownUser') || 'returntosender');
+
+    $db->set_value('SMTPSmartHost', $q->param('SMTPSmartHost'));
+    $db->set_value('DelegateMailServer', $q->param('DelegateMailServer'));
+    $db->set_value('EmailUnknownUser', $EmailUnknownUser);
+
+    my $proxy = $db->get('smtp-auth-proxy');
+    my %props = $proxy->props;
+
+    for ( qw(Userid Passwd status) )
+    {
+        $props{$_} = $q->param("SMTPAUTHPROXY_$_");
+    }
+
+    $proxy->merge_props(%props);
+
+    unless ( system( "/sbin/e-smith/signal-event", "email-update" ) == 0 )
+    {
+	$fm->error('ERROR_UPDATING_CONFIGURATION');
+	return undef;
+    }
+    $fm->success('SUCCESS');
+}
+
+sub change_settings_access
+{
+    my ($fm) = @_;
+    my $q = $fm->{'cgi'};
+
+    my $pop3Access = ($q->param('POPAccess') || 'private');
+    if ($pop3Access eq 'disabled') {
+        $db->set_prop('pop3', "status", "disabled" );
+        $db->set_prop('pop3s', "status", "disabled" );
+    } else {
+        $db->set_prop('pop3', "status", "enabled" );
+        $db->set_prop('pop3s', "status", "enabled" );
+    }
+    if ($pop3Access eq 'public') {
+        $db->set_prop('pop3', "access", "public" );
+        $db->set_prop('pop3s', "access", "public" );
+    } elsif ($pop3Access eq 'publicSSL') {
+        $db->set_prop('pop3', "access", "private" );
+        $db->set_prop('pop3s', "access", "public" );
+    } else {
+        $db->set_prop('pop3', "access", "private" );
+        $db->set_prop('pop3s', "access", "private" );
+    }
+
+    my $imapAccess = ($q->param('IMAPAccess') || 'private');
+    if ($imapAccess eq 'disabled') {
+        $db->set_prop('imap', "status", "enabled" );
+        $db->set_prop('imap', "access", "localhost" );
+        $db->set_prop('imaps', "status", "disabled" );
+    } elsif ($imapAccess eq 'public') {
+        $db->set_prop('imap', "status", "enabled" );
+        $db->set_prop('imap', "access", "public" );
+        $db->set_prop('imaps', "status", "enabled" );
+        $db->set_prop('imaps', "access", "public" );
+    } elsif ($imapAccess eq 'publicSSL') {
+        $db->set_prop('imap', "status", "enabled" );
+        $db->set_prop('imap', "access", "private" );
+        $db->set_prop('imaps', "status", "enabled" );
+        $db->set_prop('imaps', "access", "public" );
+    } else {
+        $db->set_prop('imap', "status", "enabled" );
+        $db->set_prop('imap', "access", "private" );
+        $db->set_prop('imaps', "status", "enabled" );
+        $db->set_prop('imaps', "access", "private" );
+    }
+
+    #------------------------------------------------------------
+    # Set webmail state in configuration database, and access
+    # type for SSL
+    # PHP and MySQL should always be on, and are enabled by default
+    # We don't do anything with them here.
+    #------------------------------------------------------------
+
+    my $webmail = ($q->param('WebMail') || 'disabled');
+    if ( $webmail eq "enabledSSL" || $webmail eq "enabled") {
+      $db->set_prop('php',"status", "enabled" );
+      $db->set_prop('mariadb',"status", "enabled" );
+      $db->set_prop('imp',"status", 'enabled' );
+      $db->set_prop('horde',"status", 'enabled' );
+      $db->set_prop('horde',"access", "public" );
+      $db->set_prop('horde',"HttpsOnly", "yes" );
+    }
+
+    elsif ( $webmail eq "localnetworkSSL" || $webmail eq "localnetwork" ) {
+      $db->set_prop('php',"status", "enabled" );
+      $db->set_prop('mariadb',"status", "enabled" );
+      $db->set_prop('imp',"status", 'enabled' );
+      $db->set_prop('horde',"status", 'enabled' );
+      $db->set_prop('horde',"access", "private" );
+      $db->set_prop('horde',"HttpsOnly", "yes" );
+     }
+
+    else {
+      $db->set_prop('imp',"status", 'disabled' );
+      $db->set_prop('horde',"status", 'disabled' );
+    }
+    
+    unless ( system( "/sbin/e-smith/signal-event", "email-update" ) == 0 )
+    {
+	$fm->error('ERROR_UPDATING_CONFIGURATION');
+	return undef;
+    }
+
+    $fm->success('SUCCESS');
+}
+
+sub change_settings_filtering
+{
+    my ($fm) = @_;
+    my $q = $fm->{'cgi'};
+
+    my $virus_status = ( $q->param('VirusStatus') || 'disabled' );
+    $db->set_prop("qpsmtpd", 'VirusScan', $virus_status);
+
+    for my $param ( qw(
+			status 
+			Sensitivity
+			TagLevel
+			RejectLevel
+			SortSpam 
+                        Subject
+			SubjectTag) )
+    {
+	$db->set_prop('spamassassin', $param, $q->param("Spam$param"));
+    }
+
+    my $patterns_status = $fm->adjust_patterns() ? 'enabled' : 'disabled';
+    $db->set_prop("qpsmtpd", 'PatternsScan', $patterns_status);
+
+    unless ( system( "/sbin/e-smith/signal-event", "email-update" ) == 0 )
+    {
+	$fm->error('ERROR_UPDATING_CONFIGURATION');
+	return undef;
+    }
+
+    $fm->success('SUCCESS');
+}
+
+=pod
+
+=head2 blank_or_ip_number()
+
+Validator. Checks that the input is either blank or an IP number. This is a
+wrapper around CGI::FormMagick::Validator::Network::ip_number().
+
+=for testing
+is($panel->blank_or_ip_number(),'OK','blank_or_ip_number');
+is($panel->blank_or_ip_number(''),'OK','  .. blank is valid');
+is($panel->blank_or_ip_number('1.2.3.4'),'OK','  .. "1.2.3.4" is valid');
+isnt($panel->blank_or_ip_number('bad'),'OK','  .. "bad" is invalid');
+
+=cut
+
+sub blank_or_ip_number
+{
+    my ($self,$value) = @_;
+
+    return 'OK' unless (defined $value); # undef is blank
+    return 'OK' if ($value =~ /^$/); # blank is blank
+    return $self->call_fm_validation("ip_number",$value,''); # otherwise, validate the input
+}
+
+=pod
+
+=head2 get_retrieval_options
+
+Returns the options values for the retrieval mode select box. In private
+S&G mode, we only support multidrop.
+
+=cut
+sub get_retrieval_options
+{
+    return $db->get("SystemMode")->value eq "servergateway-private"
+         ? {'multidrop' => 'MULTIDROP'}
+         : {'standard'  => 'STANDARD',
+            'etrn'      => 'ETRN',
+            'multidrop' => 'MULTIDROP'};
+}
+
+sub get_current_retrieval
+{
+    my ($fm, $localise) = @_;
+
+    my $method = $db->get_prop('fetchmail', 'Method');
+
+    my $options = get_retrieval_options();
+
+    return $localise ? $fm->localise($options->{$method}) : $method;
+}
+
+=head2 get_current_pop3_access
+
+returns "private", "public" or "publicSSL", depending on whether
+the various components of the pop3 subsystem are currently enabled
+
+=cut
+
+sub get_current_pop3_access {
+    my ($fm, $localise) = @_;
+
+    my $pop3Status = $db->get_prop('pop3', 'status') || 'enabled';
+    my $pop3Access = $db->get_prop('pop3', 'access') || 'private';
+
+    my $pop3sStatus = $db->get_prop('pop3s', 'status') || 'enabled';
+    my $pop3sAccess = $db->get_prop('pop3s', 'access') || 'private';
+
+    my $options = get_pop_options();
+
+    if ($pop3Status ne 'enabled' && $pop3sStatus ne 'enabled')
+    {
+        return $localise ? $fm->localise($options->{disabled}) : 'disabled';
+    }
+    elsif ($pop3Status eq 'enabled' && $pop3Access eq 'public')
+    {
+        return $localise ? $fm->localise($options->{public}) : 'public';
+    }
+    elsif ($pop3sStatus eq 'enabled' && $pop3sAccess eq 'public')
+    {
+        return $localise ? $fm->localise($options->{publicSSL}) : 'publicSSL';
+    }
+    return $localise ? $fm->localise($options->{private}) : 'private';
+}
+
+=head2 get_current_imap_access
+
+returns "private", "public" or "publicSSL", depending on whether
+the various components of the imap subsystem are currently enabled
+
+=cut
+
+sub get_current_imap_access {
+    my ($fm, $localise) = @_;
+
+    my $imapStatus = $db->get_prop('imap', 'status') || 'enabled';
+    my $imapAccess = $db->get_prop('imap', 'access') || 'private';
+
+    my $imapsStatus = $db->get_prop('imaps', 'status') || 'enabled';
+    my $imapsAccess = $db->get_prop('imaps', 'access') || 'private';
+
+    my $options = get_imap_options();
+
+    if (($imapStatus ne 'enabled' || $imapAccess eq 'localhost') && $imapsStatus ne 'enabled')
+    {
+        return $localise ? $fm->localise($options->{disabled}) : 'disabled';
+    }
+    if ($imapStatus eq 'enabled' && $imapAccess eq 'public')
+    {
+        return $localise ? $fm->localise($options->{public}) : 'public';
+    }
+    elsif ($imapsStatus eq 'enabled' && $imapsAccess eq 'public')
+    {
+        return $localise ? $fm->localise($options->{publicSSL}) : 'publicSSL';
+    }
+    return $localise ? $fm->localise($options->{private}) : 'private';
+}
+
+=head2 get_current_smtp_auth
+
+returns "disabled", "public" or "publicSSL", depending on whether
+the various components of the smtp auth subsystem are currently enabled
+
+=cut
+
+sub get_current_smtp_auth {
+
+    my ($fm, $localise) = @_;
+
+    my $smtpStatus = $db->get_prop('qpsmtpd', 'status') || 'enabled';
+    my $smtpAuth = $db->get_prop('qpsmtpd', 'Authentication') || 'enabled';
+
+    my $smtpsStatus = $db->get_prop('sqpsmtpd', 'status') || 'enabled';
+    my $smtpsAuth = $db->get_prop('sqpsmtpd', 'Authentication') || 'enabled';
+
+    my $options = get_smtp_auth_options();
+
+    if ($smtpStatus eq 'enabled' && $smtpAuth eq 'enabled')
+    {
+        return $localise ? $fm->localise($options->{public}) : 'public';
+    }
+    elsif ($smtpsStatus eq 'enabled' && $smtpsAuth eq 'enabled')
+    {
+        return $localise ? $fm->localise($options->{publicSSL}) : 'publicSSL';
+    }
+    return $localise ? $fm->localise($options->{disabled}) : 'disabled';
+}
+
+=head2 get_current_webmail_status
+
+returns "disabled", "localnetworkSSL" or "enabledSSL", depending on whether
+the various components of the webmail subsystem are currently enabled
+
+=cut
+
+sub get_current_webmail_status {
+
+  my ($fm, $localise) = @_;
+
+  # determine status of webmail
+  my $WebmailStatus = "disabled";
+
+  my $IMPStatus = $db->get_prop('imp', 'status') || 'disabled';
+
+  my $HordeStatus = $db->get_prop('horde', 'status') || 'disabled';
+
+  my $MysqlStatus = $db->get_prop('mariadb', 'status') || 'disabled';
+
+  my $PHPStatus = $db->get_prop('php', 'status') || 'disabled';
+
+  my $Networkaccess = $db->get_prop('horde','access') || 'disabled';
+
+  # all four components must be on for webmail to be working
+  if ( ( $IMPStatus eq "enabled" )
+       && ( $HordeStatus eq "enabled" )
+       && ( $MysqlStatus eq "enabled" )
+       && ( $PHPStatus eq "enabled"   ) 
+       && ( $Networkaccess eq "public"))
+    {
+      $WebmailStatus = "enabledSSL" ;
+    }
+
+  elsif ( ( $IMPStatus eq "enabled" )
+       && ( $HordeStatus eq "enabled" )
+       && ( $MysqlStatus eq "enabled" )
+       && ( $PHPStatus eq "enabled"   )
+       && ( $Networkaccess eq "private" ))
+    {
+      $WebmailStatus = "localnetworkSSL";
+    }
+
+  my $options = get_webmail_options();
+
+  return $localise ? $fm->localise($options->{$WebmailStatus}) 
+                   : $WebmailStatus;
+  
+}
+
+# {{{ Validation
+
+=head1 VALIDATION ROUTINES
+
+=head2 validate_smarthost
+
+Returns OK if smarthost is valid. 
+
+Returns SMARTHOST_VALIDATION_ERROR and pushes us back to the first page otherwise.
+
+=begin testing
+
+ok(validate_smarthost('','foo.com') eq 'OK', 'foo.com is a valid host');
+ok(validate_smarthost('','') eq 'OK', 'undef is a valid host');
+ok(validate_smarthost('','fleeble') eq 'INVALID_SMARTHOST', '"fleeble" is not a valid host');
+
+
+=end testing
+
+=cut
+
+sub validate_smarthost {
+    my $fm = shift;
+    my $smarthost = shift;
+    
+    return ('OK') if ( $smarthost =~ /^(\S+\.\S+)$/ );
+
+    return ('OK') if ( $smarthost eq '' );
+    
+    return "INVALID_SMARTHOST";
+    
+}
+
+=pod
+
+=head2 getExtraParams
+
+Returns some extra values for localise() that are used to evaluate embedded
+vars in localised text.
+
+=cut
+
+sub getExtraParams
+{
+	my $conf = esmith::ConfigDB->open();
+	my $systemName = $conf->get('SystemName');
+	my $domainName = $conf->get('DomainName');
+
+	$systemName = $systemName->value if ($systemName);
+	$domainName = $domainName->value if ($domainName);
+
+	return (FQDN => join('.', ($systemName, $domainName)));
+}
+
+sub get_patterns_status
+{
+    my ($self, $localise) = @_;
+
+    my $status = $db->get_prop("qpsmtpd", 'PatternsScan') || 'disabled';
+
+    return $localise ? $self->localise_status($status) : $status;
+}
+
+sub adjust_patterns
+{
+    my $fm = shift;
+    my $q = $fm->{'cgi'};
+
+    my @selected;
+    
+    push @selected, $q->param('BlockExecutableContent');
+
+    foreach my $pattern ( $pattern_db->get_all_by_prop( type => "pattern") )
+    {
+        my $status = (grep $pattern->key eq $_, @selected) ? 'enabled' 
+                                                           : 'disabled';
+        $pattern->set_prop('Status', $status);
+    }
+
+    $pattern_db->reload;
+
+    return scalar @selected;
+}
+
+sub get_patterns_options
+{
+    my $self = shift;
+
+    my %options;
+
+    foreach my $pattern ( $pattern_db->get_all_by_prop( type => "pattern" ) )
+    {
+        my %props = $pattern->props;
+
+        $options{$pattern->key} = $props{'Description'};
+    }
+
+    return \%options;
+}
+
+sub get_patterns_current_options
+{
+    my $self = shift;
+
+    my @selected;
+
+    foreach my $pattern ( $pattern_db->get_all_by_prop( type => "pattern" ) )
+    {
+        my %props = $pattern->props;
+
+        push @selected, $pattern->key if ($props{'Status'} eq 'enabled');
+    }
+
+    return \@selected;
+}
+
+sub get_smtp_auth_options
+{
+    my %options = ( disabled => 'DISABLED', publicSSL  => 'SECURE_SMTP', public => 'INSECURE_SMTP');
+
+    \%options;
+}
+
+sub get_pop_options
+{
+    my %options = (
+	disabled => 'DISABLED',
+	private => 'NETWORKS_ALLOW_LOCAL',
+	publicSSL  => 'SECURE_POP3'
+    );
+
+    my $access = $db->get_prop('pop3', 'access') || 'private';
+
+    $options{public} = 'INSECURE_POP3' if ($access eq 'public');
+
+    \%options;
+}
+
+sub get_imap_options
+{
+    my %options = (
+	disabled => 'DISABLED',
+	private => 'NETWORKS_ALLOW_LOCAL',
+	publicSSL  => 'SECURE_IMAP'
+    );
+
+    my $access = $db->get_prop('imap', 'access') || 'private';
+
+    $options{public} = 'INSECURE_IMAP' if ($access eq 'public');
+
+    \%options;
+}
+
+sub get_webmail_options
+{
+    my %options = ( disabled   => 'DISABLED', 
+               enabledSSL => 'ENABLED_SECURE_ONLY',
+               localnetworkSSL => 'ONLY_LOCAL_NETWORK_SSL' );
+
+    \%options;
+}
+
+sub get_virus_status
+{
+    my ($self, $localise) = @_;
+
+    my $status = $db->get_prop("qpsmtpd", 'VirusScan') || 'disabled';
+
+    return $localise ? $self->localise_status($status) : $status;
+}
+
+sub get_spam_status
+{
+    my ($self, $localise) = @_;
+
+    my $status = $db->get_prop('spamassassin', 'status') || 'disabled';
+
+    return $localise ? $self->localise_status($status) : $status;
+}
+
+sub get_spam_level_options
+{
+    return [ 0..20 ];
+}
+
+sub display_multidrop
+{
+    my $status = $db->get_prop('fetchmail', 'status') || 'disabled';
+
+    # XXX FIXME - WIP 
+    # Only display ETRN/multidrop settings if relevant
+    # To do this, we need an "Show ETRN/multidrop settings" button
+    # in standard mode.
+
+    # return ($status eq 'enabled');
+    return 1;	
+}
+
+sub localise_status
+{
+    my ($self, $status) = @_;
+
+    return $self->localise($status eq 'enabled' ? 'ENABLED' : 'DISABLED');
+}
+
+sub nonblank_if_smtpauth
+{
+    my ($fm, $value) = @_;
+
+    my $q = $fm->{'cgi'};
+
+    return "OK" unless ($q->param("SMTPAUTHPROXY_status") eq 'enabled');
+
+    return ($value =~ /\S+/) ? "OK" : "VALIDATION_SMTPAUTH_NONBLANK";
+}
+
+sub display_access_page
+{
+    for ( qw(imp imap pop3) )
+    {
+        return 1 if $db->get_prop($_, 'type');
+    }
+
+    return 0;
+}
+
+1;
--- a/root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/pseudonyms.pm
+++ b/root/usr/share/perl5/vendor_perl/esmith/FormMagick/Panel/pseudonyms.pm
@@ -0,0 +1,594 @@
+#!/usr/bin/perl -w 
+
+#
+# $Id: pseudonyms.pm,v 1.20 2005/04/26 15:39:42 charlieb Exp $
+#
+
+package esmith::FormMagick::Panel::pseudonyms;
+
+use strict;
+use esmith::AccountsDB;
+use esmith::ConfigDB;
+use esmith::FormMagick;
+use esmith::util;
+use File::Basename;
+use Exporter;
+use Carp;
+use URI::Escape;
+
+our @ISA = qw(esmith::FormMagick Exporter);
+
+our @EXPORT = qw( 
+    get_prop 
+    get_value 
+    get_cgi_param
+    performCreatePseudonym  
+    performModifyPseudonym 
+    performRemovePseudonym 
+    existing_accounts 
+    print_begin_page 
+    print_hidden_pseudonym_field
+    get_pseudonym_account 
+    is_pseudonym_internal
+    is_pseudonym_not_removable
+    validate_new_pseudonym_name
+    validate_is_pseudonym 
+);
+
+our $VERSION = sprintf '%d.%03d', q$Revision: 1.20 $ =~ /: (\d+).(\d+)/;
+
+our $config = esmith::ConfigDB->open();
+our $accounts = esmith::AccountsDB->open();
+
+
+# {{{ header
+
+=pod 
+
+=head1 NAME
+
+esmith::FormMagick::Panels::pseudonyms - useful panel functions
+
+=head1 SYNOPSIS
+
+    use esmith::FormMagick::Panels::pseudonyms;
+
+    my $panel = esmith::FormMagick::Panel::pseudonyms->new();
+    $panel->display();
+
+=head1 DESCRIPTION
+
+=cut
+
+# }}}
+
+# {{{ new
+
+=head2 new();
+
+Exactly as for esmith::FormMagick
+
+=begin testing
+
+
+use_ok('esmith::FormMagick::Panel::pseudonyms');
+use vars qw($panel);
+ok($panel = esmith::FormMagick::Panel::pseudonyms->new(), "Create panel object");
+isa_ok($panel, 'esmith::FormMagick::Panel::pseudonyms');
+
+=end testing
+
+=cut
+
+sub new {
+    shift;
+    my $self = esmith::FormMagick->new();
+    $self->{calling_package} = (caller)[0];
+    bless $self;
+    return $self;
+}
+
+# }}}
+
+=head2 get_cgi_param FM FIELD
+
+Returns the named CGI parameter as a string
+
+=cut
+
+sub get_cgi_param {
+    my $fm = shift;
+    my $param = shift;
+
+    return ($fm->{'cgi'}->param($param));
+}
+
+# {{{ get_prop
+
+=head2 get_prop ITEM PROP
+
+A simple accessor for esmith::ConfigDB::Record::prop
+
+=cut
+
+sub get_prop {
+    my $fm = shift;
+    my $item = shift;
+    my $prop = shift;
+
+    my $record = $config->get($item);
+    if ($record) {
+        return $record->prop($prop);
+    }
+    else {
+        return '';
+    }
+}
+
+# }}}
+
+# {{{ get_value 
+
+=head2 get_value ITEM
+
+A simple accessor for esmith::ConfigDB::Record::value
+
+=cut
+
+sub get_value {
+    my $fm = shift;
+    my $item = shift;
+
+    my $record = $config->get($item);
+    if ($record) {
+        return $record->value();
+    }
+    else {
+        return '';
+    }
+}
+
+# }}}
+
+=head1 ACTION
+
+=head2 performCreatePseudonym
+
+Create a new pseudonym
+
+=cut
+
+# {{{ performCreatePseudonym
+
+sub performCreatePseudonym  {
+    my $fm = shift;
+    my $q = $fm->{'cgi'};
+    my $account = $q->param ('account');
+    my $pseudonym = uri_unescape($q->param('pseudonym')); 
+    my $internal = $q->param ('internal') || 'NO';
+    my $msg = "OK";
+
+    $accounts->new_record($pseudonym, { type => 'pseudonym', 
+                                     Account => $account} )
+        or $msg = "Error occurred while creating pseudonym in database.";
+
+    if ($internal eq "YES") { 
+	my %props = ('Account' =>  $pseudonym);
+     	$props{'Visible'} = 'internal'; 
+	$props{'internal'} = $internal;
+    	$accounts->get($pseudonym)->merge_props(%props)
+        	or $msg = "Error occurred while modifying pseudonym in database.";
+	}
+    # Untaint $pseudonym before use in system()
+    ($pseudonym) = ($pseudonym =~ /([\w\p{L}.]+)/);
+    system( "/sbin/e-smith/signal-event", "pseudonym-create", "$pseudonym",) 
+        == 0 or $msg = "Error occurred while creating pseudonym.";
+
+    if ($msg eq "OK") 
+    {
+        $q->delete('account');
+        $q->delete('pseudonym');
+        $fm->success('CREATE_SUCCEEDED');
+    }
+    else
+    {
+        $fm->error($msg);
+    }
+}
+# }}}
+
+# {{{ performModifyPseudonym
+
+=head2 performModifyPseudonmy
+
+Modify a pseudonym.
+
+=cut
+
+sub performModifyPseudonym {
+    my $fm = shift;
+    my $q = $fm->{'cgi'};
+    my $msg = "OK";
+
+    my $pseudonym = uri_unescape($q->param ('pseudonym'));
+    my $account = $q->param ('account');
+    my $internal = $q->param ('internal') || 'NO';
+    my $removable = $accounts->get($pseudonym)->prop('Removable') || 'yes';
+
+    my %props = ('Account' =>  $account);
+
+    if ($removable eq 'yes') {
+        if ($internal eq "YES") { $props{'Visible'} = 'internal'; }
+        else { $accounts->get($pseudonym)->delete_prop('Visible'); }
+    }
+
+    $accounts->get($pseudonym)->merge_props(%props)
+        or $msg = "Error occurred while modifying pseudonym in database.";
+
+    # Untaint $pseudonym before use in system()
+    ($pseudonym) = ($pseudonym =~ /([\w\p{L}.]+)/);
+    system( "/sbin/e-smith/signal-event", "pseudonym-modify", "$pseudonym",)
+        == 0 or $msg = "Error occurred while modifying pseudonym.";
+
+    if ($msg eq "OK")
+    {
+        $q->delete('account');
+        $q->delete('pseudonym');
+        $q->delete('internal');
+        $fm->success('MODIFY_SUCCEEDED');
+    }
+    else
+    {
+        $fm->error($msg);
+    }
+}
+# }}}
+
+# {{{ performRemovePseudonym
+
+sub performRemovePseudonym {
+    my $fm = shift;
+    my $q = $fm->{'cgi'};
+    my $msg = "OK";
+
+    my $pseudonym = uri_unescape($q->param('pseudonym'));
+
+    unless($fm->validate_is_pseudonym($pseudonym) eq 'OK') {
+        $fm->{cgi}->param( -name => 'wherenext', -value => 'InvalidPseudonym' );
+        return '';
+    }
+
+    #------------------------------------------------------------
+    # Make the pseudonym inactive, signal pseudonym-delete event
+    # and then delete it
+    #------------------------------------------------------------
+
+    my @pseudonyms = $accounts->pseudonyms();
+
+    foreach my $p_rec (@pseudonyms) {
+        if ($p_rec->prop("Account") eq $pseudonym) {
+            $accounts->get($p_rec->key)->set_prop('type','pseudonym-deleted')
+                or $msg = "Error occurred while changing pseudonym type.";
+        }
+    }
+
+    $accounts->get($pseudonym)->set_prop('type','pseudonym-deleted')
+        or $msg = "Error occurred while changing pseudonym type.";
+
+    # Untaint $pseudonym before use in system()
+    ($pseudonym) = ($pseudonym =~ /([\w\p{L}.]+)/);
+    system( "/sbin/e-smith/signal-event", "pseudonym-delete", "$pseudonym") == 0
+        or $msg = "Error occurred while removing pseudonym.";
+
+    #TODO: is it ->delete or get()->delete
+    foreach my $p_rec (@pseudonyms) {
+        if ($p_rec->prop("Account") eq $pseudonym) {
+            next unless $p_rec->type eq "pseudonym-deleted";
+            $accounts->get($p_rec->key)->delete()
+                or $msg = "Error occurred while deleting pseudonym from database.";
+        }
+    }
+
+    $accounts->get($pseudonym)->delete()
+        or $msg = "Error occurred while deleting pseudonym from database.";
+
+    if ($msg eq "OK")
+    {
+        $q->delete('pseudonym');
+        $fm->success('REMOVE_SUCCEEDED');
+    }
+    else
+    {
+        $fm->error($msg);
+    }
+
+    return '';
+}
+
+# }}} remove pseudonym
+
+# {{{ existing_accounts
+
+=head2 existing_accounts
+
+Return a hash of exisitng system accounts
+
+=cut
+
+sub existing_accounts {
+    my $fm = shift;
+    my %existingAccounts = ('admin' => "Administrator" );
+
+    foreach my $account ($accounts->get_all) {
+        if ($account->prop('type') =~ /(user|group)/) {
+            $existingAccounts{$account->key} = $account->key;
+        }
+        if ($account->prop('type') eq "pseudonym") {
+            my $target = $accounts->get($account->prop('Account'));
+
+            unless ($target)
+            {
+                warn "WARNING: pseudonym (" 
+			. $account->key 
+			. ") => missing Account(" 
+			. $account->prop('Account') 
+			. ")\n";
+                next;
+            }
+
+            $existingAccounts{$account->key} = $account->key 
+                unless ($target->prop('type') eq "pseudonym");
+        }
+    }
+    return(\%existingAccounts); 
+}
+
+# }}}
+
+# {{{ print_begin_page
+
+=head2 print_begin_page 
+
+Print the initial page of the ofrm
+
+=cut
+
+sub print_begin_page {
+    my $fm = shift;
+    my $q = $fm->{'cgi'};
+    my @emailPseudonyms;
+    # Need to untie and re-tie the accounts database to ensure changes
+    # are recognised.
+    foreach my $account ($accounts->get_all()) {
+        my $type = $account->prop('type');
+        my $key = $account->key();
+        push (@emailPseudonyms, $key) if ($type eq 'pseudonym');
+    }
+    my $urlprefix = $fm->build_cgi_params(uri_unescape($q->param('pseudonym')));    
+    print "  <tr>\n    <td colspan='2'>\n";
+    print $q->p($q->a({href => "pseudonyms?$urlprefix&wherenext=Create", -class => "button-like"},
+                $fm->localise("CLICK_TO_CREATE")));
+
+    my $numPseudonyms = @emailPseudonyms;
+    if ($numPseudonyms == 0) {
+        print $q->h2($fm->localise('NO_PSEUDONYMS'));
+    } else {
+        print $q->h2($fm->localise('CURRENT_PSEUDONYMS'));
+        print $q->start_table ({-CLASS => "sme-border"});
+        print "<tr>      <th class=\"sme-border\">".$fm->localise('PSEUDONYM') ."</th>\n".
+            "      <th class=\"sme-border\">".$fm->localise('USER_OR_GROUP') . "</th>\n" .
+            "      <th class=\"sme-border\" colspan=\"2\">".$fm->localise('ACTION') . "</th></tr>\n";
+
+        foreach my $pseudonym (sort @emailPseudonyms) {
+            my $account = $accounts->get($pseudonym)->prop('Account');
+
+            $account = "Administrator" if ($account eq "admin");
+            $account = $fm->localise("EVERYONE") if ($account eq "shared");
+
+            my $removable = $accounts->get($pseudonym)->prop('Removable') || 'yes';
+            my $changeable = $accounts->get($pseudonym)->prop('Changeable') || 'yes';
+
+            my $visible = $accounts->get($pseudonym)->prop('Visible');
+            $account .= $fm->localise("LOCAL_ONLY")
+                if (defined $visible && $visible eq "internal");
+
+            my $urlprefix = $fm->build_cgi_params($pseudonym);
+            print "    <tr>\n" .
+                "      <td class=\"sme-border\">$pseudonym</td>\n" .
+                "      <td class=\"sme-border\">$account</td>\n";
+            if ($changeable eq 'no') {
+                print "      <td class=\"sme-border\">&nbsp;</td>\n";
+            } else {
+                print "      <td class=\"sme-border\">".$q->a({href => "pseudonyms?$urlprefix&wherenext=Modify"},$fm->localise("MODIFY"))."</td>\n";
+            }
+            if ($removable eq 'no') {
+                print "      <td class=\"sme-border\">&nbsp;</td>\n";
+            } else {
+                print "      <td class=\"sme-border\">".$q->a({href => "pseudonyms?$urlprefix&wherenext=Remove"},$fm->localise("REMOVE"))."</td>\n";
+            }
+            print "</tr>";
+        }
+
+        print $q->end_table,"\n";
+    }
+    print "</td></tr>";
+    return '';
+}
+
+# }}}
+
+# {{{ get_pseudonym_account
+
+=head2 get_pseudonym_account
+
+Returns the current Account property for this pseudonym
+
+=cut
+
+sub get_pseudonym_account {
+    my $fm = shift;
+    my $q = $fm->{'cgi'};
+    my $pseudonym = uri_unescape($q->param('pseudonym'));
+    my $account = $accounts->get($pseudonym)->prop('Account');
+    if ($account eq "admin") {
+        $account = "Administrator";
+    } elsif ($account eq "shared") {
+        $account = $fm->localise("EVERYONE"); 
+    }
+    return($account);
+}
+# }}}
+
+# {{{ is_pseudonym_not_removable
+
+=head2 is_pseudonym_not_removable
+
+Returns 1 if the current Account is not removable, 0 otherwise
+
+=cut
+
+sub is_pseudonym_not_removable {
+    my $fm = shift;
+    my $q = $fm->{'cgi'};
+    my $pseudonym = uri_unescape($q->param('pseudonym'));
+    my $removable = $accounts->get($pseudonym)->prop('Removable') || 'yes';
+    return 1  if ($removable eq 'yes');
+    return 0;
+}
+# }}}
+
+# {{{ is_pseudonym_internal
+
+=head2 is_pseudonym_internal
+
+Returns YES if the current Account property Visible is 'internal'
+
+=cut
+
+sub is_pseudonym_internal {
+    my $fm = shift;
+    my $q = $fm->{'cgi'};
+    my $pseudonym = uri_unescape($q->param('pseudonym'));
+    my $visible = $accounts->get($pseudonym)->prop('Visible') || '';
+    return 'YES'  if ($visible eq 'internal');
+    return 'NO';
+}
+# }}}
+
+# {{{ validate_new_pseudonym_name 
+
+=head2 validate_new_pseudonym_name FM PSEUDONYM
+
+Returns "OK" if the pseudonym starts with a letter or number and
+contains only letters, numbers, . - and _ and isn't taken
+
+Returns  "VALID_PSEUDONYM_NAMES"  if the name contains invalid chars
+
+Returns "NAME_IN_USE" if this pseudonym is taken.
+
+=begin testing
+
+ok(esmith::FormMagick::Panel::pseudonyms::validate_new_pseudonym_name('',"23skidoo") eq 'OK', "23skidoo is a valid pseudonym");
+ok(esmith::FormMagick::Panel::pseudonyms::validate_new_pseudonym_name('',"_23skidoo") ne 'OK', "_23skidoo is not  a valid pseudonym");
+ok(esmith::FormMagick::Panel::pseudonyms::validate_new_pseudonym_name('',"_23skidoo") eq 'VALID_PSEUDONYM_NAMES', "_23skidoo is  an invalid pseudonym");
+
+=end testing
+
+
+=cut
+
+sub validate_new_pseudonym_name {
+    my $fm = shift;
+    my $pseudonym = shift;
+
+    my $acct = $accounts->get($pseudonym);
+    if (defined $acct) {
+        return('NAME_IN_USE');
+    }
+    elsif ($pseudonym =~ /@/)
+    {
+        use esmith::DomainsDB;
+
+        my $ddb = esmith::DomainsDB->open_ro
+                or die "Couldn't open DomainsDB\n";
+
+        my ($lhs, $rhs) = split /@/, $pseudonym;
+
+        return ('PSEUDONYM_INVALID_DOMAIN') unless ($ddb->get($rhs));
+
+        return ('PSEUDONYM_INVALID_SAMEACCT')
+            if ($lhs eq $fm->{'cgi'}->param('account'));
+
+        return ('OK');
+    }
+    elsif ($pseudonym !~ /^([a-z0-9][a-z0-9\.\-_!#\?~\$\^\+&`%\/\*]*)$/)
+    {
+        return('VALID_PSEUDONYM_NAMES');
+    }
+    else {
+        return('OK');
+    }
+}
+
+# }}}
+
+# {{{ validate_is_pseudonym 
+
+=head2 validate_is_pseudonym FM NAME
+
+returns  "OK" if it is.
+returns "NOT_A_PSUEDONYM" if the name in question isn't an existing pseudonym
+
+=cut
+
+sub validate_is_pseudonym {
+    my $fm = shift;
+    my $pseudonym = shift;
+    $pseudonym = $accounts->get($pseudonym);
+    return('NOT_A_PSEUDONYM') unless $pseudonym;
+    my $type = $pseudonym->prop('type');
+
+    unless (defined $type && ($type eq 'pseudonym') ) {
+
+        return('NOT_A_PSEUDONYM');
+    }
+    return ('OK');
+}
+
+# }}}
+                                                                 
+=head2 build_cgi_params()                                        
+                                                                 
+Builds a CGI query string, using various sensible                
+defaults and esmith::FormMagick's props_to_query_string() method.
+                                                                 
+=cut                                                             
+                                                                 
+sub build_cgi_params {                                           
+    my ($fm, $pseudonym) = @_;                                       
+
+    my %props = (                                                
+            page       => 0,                                            
+            page_stack => "",                                        
+            ".id"      => $fm->{cgi}->param('.id') || "",         
+            pseudonym  => $pseudonym,                                   
+            );                                                           
+
+    return $fm->props_to_query_string(\%props);                  
+}                                                                
+
+=head2 print_hidden_pseudonym_field FM
+
+prints a hidden form field containing the current value of the pseudonym
+attribute
+
+
+=cut
+
+sub print_hidden_pseudonym_field {
+    my $fm = shift;
+    print "<input type='hidden' name='pseudonym' value=\"".uri_escape($fm->{'cgi'}->param('pseudonym'))."\">";
+    return '';
+}
+
+1;