| 1 |
package ConfirmationSpool;
|
| 2 |
|
| 3 |
# Copyright 2002 Raphaël Hertzog <hertzog@debian.org>
|
| 4 |
# Available under the terms of the General Public License version 2
|
| 5 |
# or (at your option) any later version
|
| 6 |
|
| 7 |
use Digest::MD5 qw(md5_hex);
|
| 8 |
|
| 9 |
use strict;
|
| 10 |
|
| 11 |
=head1 ConfirmationSpool
|
| 12 |
|
| 13 |
A confirmation spool is a set of strings that are waiting a confirmation
|
| 14 |
in the form of a key. Usually the key is used to authenticate a mail
|
| 15 |
adress. You get a command with an email adress, and you want to be sure
|
| 16 |
that the email is not forged. You send a confirmation mail indicating
|
| 17 |
to respond with the given "key" (which should not be predictable). Once
|
| 18 |
you get the key back, you're sure that the email is not forged and that
|
| 19 |
the person concerned accepted the command that was sent.
|
| 20 |
|
| 21 |
=head2 my $cs = ConfirmationSpool->new($spooldir)
|
| 22 |
|
| 23 |
When you create a confirmation spool, you need to indicate a directory
|
| 24 |
in which the strings (mails) waiting a confirmation will be stored.
|
| 25 |
|
| 26 |
=cut
|
| 27 |
sub new {
|
| 28 |
my $type = shift;
|
| 29 |
my $class = ref($type) || $type;
|
| 30 |
my $directory = shift;
|
| 31 |
|
| 32 |
die "$directory is not a directory: $!\n" if (! -d $directory);
|
| 33 |
|
| 34 |
my $self = { "dir" => $directory, "sendmail" => "/usr/sbin/sendmail" };
|
| 35 |
|
| 36 |
return bless $self, $class;
|
| 37 |
}
|
| 38 |
|
| 39 |
=head2 $cs->set_confirmation_template($fileorstring)
|
| 40 |
|
| 41 |
Set the file used as a template to ask for a confirmation of something.
|
| 42 |
@CMD@ will be automatically replaced by the string to authenticate. @KEY@
|
| 43 |
will be replaced by the key that the user has to send back to authenticate
|
| 44 |
the command.
|
| 45 |
|
| 46 |
If the file doesn't exist, the param is considered as a string containing
|
| 47 |
the confirmation template.
|
| 48 |
|
| 49 |
The template must be a complete mail ready to be piped into "sendmail -t".
|
| 50 |
|
| 51 |
=cut
|
| 52 |
sub set_confirmation_template {
|
| 53 |
my ($self, $templ) = @_;
|
| 54 |
my $res = "";
|
| 55 |
if (-f $templ) {
|
| 56 |
open(TEMPLATE, "< $templ") || die "Can't open $templ : $!\n";
|
| 57 |
while (defined($_ = <TEMPLATE>)) {
|
| 58 |
$res .= $_;
|
| 59 |
}
|
| 60 |
close(TEMPLATE);
|
| 61 |
} else {
|
| 62 |
$res = $templ;
|
| 63 |
}
|
| 64 |
$self->{'template'} = $res;
|
| 65 |
}
|
| 66 |
|
| 67 |
=head2 $key = $cs->ask_confirmation($email, $string)
|
| 68 |
|
| 69 |
Add a string to be confirmed. Send a confirmation mail (it uses
|
| 70 |
the template set with set_confirmation_template)
|
| 71 |
|
| 72 |
=cut
|
| 73 |
sub ask_confirmation {
|
| 74 |
my ($self, $email, $string, $subst) = @_;
|
| 75 |
|
| 76 |
$subst = { } if (! defined $subst);
|
| 77 |
|
| 78 |
# Generate a unique code
|
| 79 |
srand(time());
|
| 80 |
my @trans = ('A' .. 'Z', 'a' .. 'z', 0 .. 9);
|
| 81 |
my $nb = scalar @trans;
|
| 82 |
my @rand;
|
| 83 |
for(my $i = 0; $i < 16; $i++) { push @rand, int(rand($nb)) }
|
| 84 |
my $key = md5_hex(join("", $string, time(), map { $trans[$_] } @rand));
|
| 85 |
|
| 86 |
# Store the string with the given key
|
| 87 |
open(SPOOL, "> $self->{'dir'}/$key") ||
|
| 88 |
die "Can't write spool file: $!\n";
|
| 89 |
print SPOOL $string;
|
| 90 |
close SPOOL;
|
| 91 |
|
| 92 |
# Send the confirmation message
|
| 93 |
my $msg = $self->{'template'};
|
| 94 |
$msg =~ s/\@EMAIL\@/$email/g;
|
| 95 |
$msg =~ s/\@KEY\@/$key/g;
|
| 96 |
foreach my $varname (keys %{$subst}) {
|
| 97 |
my $name = uc($varname);
|
| 98 |
$msg =~ s/\@$name\@/$subst->{$varname}/g;
|
| 99 |
}
|
| 100 |
open(MAIL, "| $self->{'sendmail'} -oi -t")
|
| 101 |
or die "Can't fork sendmail: $!\n";
|
| 102 |
print MAIL $msg;
|
| 103 |
close MAIL or die "Problem happened while sending mail: $!\n";
|
| 104 |
}
|
| 105 |
|
| 106 |
=head2 $string = $cs->confirm($key)
|
| 107 |
|
| 108 |
Verify that the key confirms a previously sent command. Returns the
|
| 109 |
command if ok, undef otherwise.
|
| 110 |
|
| 111 |
=cut
|
| 112 |
sub confirm {
|
| 113 |
my ($self, $key) = @_;
|
| 114 |
|
| 115 |
# Check in the spool
|
| 116 |
if (! -f "$self->{'dir'}/$key") {
|
| 117 |
return undef;
|
| 118 |
}
|
| 119 |
|
| 120 |
# Return the content of the file
|
| 121 |
my $msg;
|
| 122 |
open(SPOOL, "< $self->{'dir'}/$key") || die "Can't open $key file: $!\n";
|
| 123 |
while (defined($_ = <SPOOL>)) { $msg .= $_ }
|
| 124 |
close SPOOL;
|
| 125 |
|
| 126 |
unlink "$self->{'dir'}/$key";
|
| 127 |
|
| 128 |
return $msg;
|
| 129 |
}
|
| 130 |
|
| 131 |
=head2 $cs->clean()
|
| 132 |
|
| 133 |
Check the spool and remove files that have not been confirmed within
|
| 134 |
3 days.
|
| 135 |
|
| 136 |
=cut
|
| 137 |
sub clean {
|
| 138 |
my ($self) = @_;
|
| 139 |
|
| 140 |
# Read the content of the spool
|
| 141 |
opendir(DIR, $self->{'dir'}) || die "can't opendir $self->{'dir'}: $!";
|
| 142 |
my @files = grep { (! /^\./) && -f "$self->{'dir'}/$_" } readdir(DIR);
|
| 143 |
closedir DIR;
|
| 144 |
|
| 145 |
# Remove old files
|
| 146 |
my $t = time();
|
| 147 |
foreach (@files) {
|
| 148 |
my @stat = stat "$self->{'dir'}/$_";
|
| 149 |
if ($stat[9] + 86400 * 3 < $t) {
|
| 150 |
unlink "$self->{'dir'}/$_";
|
| 151 |
}
|
| 152 |
}
|
| 153 |
}
|
| 154 |
|
| 155 |
=head2 $cs->set_sendmail("/usr/sbin/sendmail");
|
| 156 |
|
| 157 |
Update the path to the sendmail binary. Sendmail is used to send
|
| 158 |
confirmation mails...
|
| 159 |
|
| 160 |
=cut
|
| 161 |
sub set_sendmail {
|
| 162 |
my ($self, $sendmail) = @_;
|
| 163 |
$self->{'sendmail'} = $sendmail;
|
| 164 |
}
|
| 165 |
|
| 166 |
1;
|
Parent Directory
| 
Revision Log