2 ################################################################################
4 # File: $RCSfile: add2whitelist.cgi,v $
5 # Revision: $Revision: 1.1 $
6 # Description: Add an email address to the whitlist
7 # Author: Andrew@DeFaria.com
8 # Created: Mon Jan 16 20:25:32 PST 2006
9 # Modified: $Date: 2013/06/12 14:05:47 $
12 # (C) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
14 ################################################################################
20 local $0 = $FindBin::Script;
22 use lib "$FindBin::Bin/../lib";
23 use lib "$FindBin::Bin/../../lib";
31 use CGI qw/:standard *table/;
32 use CGI::Carp 'fatalsToBrowser';
37 CheckParms(['userid', 'type'], \%rec);
39 my $nextseq = GetNextSequenceNo(%rec);
41 my $Userid = ucfirst $rec{userid};
44 $rec{pattern} = param "pattern$nextseq";
45 $rec{domain} = param "domain$nextseq";
46 $rec{comment} = param "comment$nextseq";
47 $rec{hit_count} = param "hit_count$nextseq";
48 $rec{retention} = param "retention$nextseq";
50 last unless $rec{pattern} or $rec{domain};
52 $rec{sender} = CheckEmail $rec{pattern}, $rec{domain};
54 my ($status) = OnWhitelist($rec{sender}, $rec{userid});
57 print br {-class => 'error'},
58 "The email address $rec{sender} is already on ${Userid}'s $rec{type} list";
60 my ($messages, $msg) = Add2Whitelist(%rec);
63 print br {-class => 'error'}, "Unable to add $rec{sender} to $rec{type} list\n$msg";
66 print br "The email address, $rec{sender}, has been added to ${Userid}'s $rec{type} list";
71 print br 'Your previous message has been delivered';
73 print br "Your previous $messages messages have been delivered";
75 } elsif ($messages == 0) {
76 print br 'Unable to find any old messages but future messages will now be delivered.';
77 } elsif ($messages < 0) {
78 print br {-class => 'error'}, $msg;
83 # Now remove this entry from the other lists (if present)
84 for my $otherlist ('black', 'null') {
86 userid => $rec{userid},
88 sender => $rec{sender},
93 if ($seq->{sequence}) {
96 ($err, $msg) = DeleteList(
97 userid => $rec{userid},
99 sequence => $seq->{sequence},
102 croak $msg if $err < 0;
104 print br "Removed $rec{sender} from ${Userid}'s " . ucfirst $otherlist . ' list'
108 userid => $rec{userid},
122 my $userid = Heading(
129 $userid ||= $ENV{USER};
133 NavigationBar($userid);
144 -action => 'processaction.cgi',
148 print '<p></p><center>',
149 hidden ({-name => 'type',
151 submit ({-name => 'action',