#!/usr/bin/perl -Tw
######################################################################
# emailreg.pl
######################################################################
# Perl Power! - Michael Schilli 1998
######################################################################

use CGI qw/:standard :html3/;      # standard CGI functions
use Fcntl qw/:flock/;              # define LOCK_EX etc.
use Mail::Send;                    # mail functions

my $efile           = '/usr/data/email.dat'; # address file
                                   # email of registry system
my $regsystem_email = 'register@registration.com';

if(! defined param('email')) {     # no email registered (first 
                                   # call?) => introduction page
    print_form("Please enter your email address.");

} elsif (param('email') =~ /\S\@.+?\..+/) {

                                   # create unique ID
    $id = unpack ('H*', pack('Nc', time, $$ % 0xff));

                                   # store, verification mail
    if(register_email(param('email'), $efile, $id)) {
        print_form("Registration received. Please wait" .
                   "for incoming mail and answer this " .
                   "to confirm your registration.");
        send_mail(param('email'), $id, $regsystem_email);
    } else {
        print_form("Error: $ERROR");
    }

} else {                           # nonsense entered, repeat 
                                   # with error message.
    print_form("Invalid email address - please try again.");
}

######################################################################
sub print_form {                   # output form with message text
######################################################################
    my ($message) = @_;

    print header,
          start_html('-title' => "Registration"),
          h2($message), start_form(), 
          table(TR(td("Email:"),
                   td(textfield(-name => 'email', 
                                -value => (param('email') || ""))),
                   td(submit(-value => "Register")))),
          end_form();
}

######################################################################
sub register_email {               # store email in file
######################################################################
    my ($email, $filename, $id) = @_;
                                   # create file if it 
                                   # does not yet exist
    do {open(FILE, ">$efile"); close(FILE)} unless -f $efile;

    if(!open(FILE, "+<$efile")) {  # open read/write
        $ERROR = "$efile cannot be opened (internal error)."; 
        return 0;
    }

    flock(FILE, LOCK_EX);          # protect against parallel access
    seek(FILE, 0, 0);              # go to beginning of file

    while(<FILE>) {                # search for new email
        chomp;                     # strip newline
        if($_ eq $email) {
            $ERROR = "You are already registered."; 
            close(FILE);
            return 0;
        }
    }
        
    seek(FILE, 0, 2);              # append email to and of file
    print FILE "$email $id\n";
    close(FILE);
    return 1;
}

######################################################################
sub send_mail {
######################################################################
    my ($to, $key, $from) = @_;

    my $mail=Mail::Send->new(              # new mail object 
         Subject => "Your registration (key: $key)", # subject
         To      => $to);                  # addressee
 
    $mail->set("From", $from);             # sender
    $mail->set("Reply-To", $from);         # reply address
    
    $mailhandle = $mail->open("sendmail"); # start mail program
                             
    print $mailhandle <<EOT;               # create text
       Dear $to,

       in order to confirm your registration, please send
       this mail simply back to the sender by using the reply
       function of your mail program. Thank you!

       Virtually yours, your email registry
EOT
                             
    $mailhandle->close();                  # close and send
}