courier-webadmin 0.76.3-5+deb9u1 / usr / share / courier / webadmin / webadmin.pm

#
# Copyright 2001 Double Precision, Inc.  See COPYING for
# distribution information.

1;

sub validhostname {

    my $h=shift;

    return $1 if $h =~ /^\s*([a-zA-Z0-9\-\.]+)\s*$/;
    return undef;
}

# Attempt to weed out syntactically invalid addresses

sub validaddress {
    my $addr=shift;

    $addr =~ s/^\s+//;
    $addr =~ s/\s+$//;

    return undef if $addr =~ /[\s,\"\\:;<>\[\]!%\(\)[:cntrl:]]/;

    my $host="";

    if ($addr =~ /(.*)@(.*)/)
    {
	($addr, $host)=($1, $2);

	return undef unless defined ($host=validhostname($host));

	$host=lc($host);
	$host="\@$host";
    }

    return "$addr$host";
}

# An entry in the alias file can be either an address, a program call
# or a mailbox filepath.

sub validaliasaddress {
    my $a=shift;

    $a =~ s/^\s+//;

    if ($a =~ /^[\/\|]/)
    {
	return undef if $a =~ /[\\\*\?\~\'\"\[\][:cntrl:]]/;
	return $a;
    }

    return validaddress($a);
}

# Parse an RFC 822 addrlist

sub addrlist {
    my @list;

    my $str=shift;

    return () if $str =~ /[\:\;<>\[\]\!\%\(\)[:cntrl:]]/;

    while ($str =~ /./)
    {
	if ($str =~ /^[\s,](.*)/)
	{
	    $str=$1;
	    next;
	}

	if ($str =~ /^[\/\|]/)
	{
	    return undef if $str =~ /[\"\\]/;
	    push @list, $str;
	    last;
	}

	my $inq=0;
	my $s="";
	my $ch;

	while ($str =~ /^(.)(.*)$/)
	{
	    ($ch, $str)=($1, $2);

	    ++$inq if $ch eq "\"";

	    if (! ($inq & 1))
	    {
		last if $ch eq ",";
		last if $ch =~ /\s/;
	    }

	    if ($ch eq "\\" && $str =~ /^(.)(.*)$/)
	    {
		$s .= $ch;
		($ch, $str)=($1, $2);
	    }
	    $s .= $ch;
	}

	$s=$1 if $inq == 2 && $s =~ /^\"(.*)\"$/;
	push @list, $s;
    }

    return @list;

}

# Read our aliases file

sub readaliases {

    my %aliases;

    my $fh=OpenConfigFile("aliases/webadmin");

    if (defined $fh)
    {
	my $n;

	while (<$fh>)
	{
	    chomp;

	    next if /^#/;

	    my $l=$_;

	    ($n, $l)=($1, $2) if $l =~ /^([^:\s]+):\s*(.*)/;

	    $l =~ s/^\s*//;
	    next if $l eq "";

	    my @a=addrlist($l);

	    next if $#a < 0;

	    $aliases{$n}=[] unless defined $aliases{$n};

	    my $aa=$aliases{$n};

	    push @$aa, @a;
	}
	close($fh);
    }

    return \%aliases;
}

sub savealiases {
    my $aliases=shift;

    my $fh=NewConfigFile("aliases/webadmin");

    print $fh "# Automatically generated by webadmin - DO NOT EDIT THIS FILE\n";
    foreach (sort keys %$aliases)
    {
	my $key=$_;

	my $aa=$$aliases{$key};

	my @aa=@$aa;

	while ($#aa >= 0)
	{
	    my @addy=splice(@aa, 0, 5);

	    grep {
		$_ =~ s/^([\/\|].*)/"\"$1\""/e;
	    } @addy;

	    print $fh "\n$key: " . join(",", @addy) . "\n";
	}
    }
    close ($fh);
}

# Automatically update locals

sub addacceptmailfor {
    my $domain=validhostname(shift);

    return unless defined $domain;

    my @l;

    foreach(ReadMultiLineConfigFile("esmtpacceptmailfor.dir/webadmin"))
    {
	push @l, $_ unless lc($_) eq lc($domain);
    }

    push @l, $domain;

    SaveMultiLineConfigFile("esmtpacceptmailfor.dir/webadmin", \@l);
    changed("$sbindir/makeacceptmailfor");
}

sub delacceptmailfor {
    my $domain=validhostname(shift);

    my @l;

    foreach(ReadMultiLineConfigFile("esmtpacceptmailfor.dir/webadmin"))
    {
	push @l, $_ unless lc($_) eq lc($domain);
    }

    SaveMultiLineConfigFile("esmtpacceptmailfor.dir/webadmin", \@l);
    changed("$sbindir/makeacceptmailfor");
}

# Convenient functions for validating input

sub param {
    my $s=$cgi->param(shift);

    $s =~ s/^\s+//;
    $s =~ s/\s+$//;
    return $s;
}

sub required {
    foreach (@_)
    {
	return 0 unless param($_);
    }
    return 1;
}