use strict; # Modules use CGI::Carp; use CGI qw(:standard escapeHTML); use LWP::UserAgent; # CGI.pm versioning issue $CGI::USE_PARAM_SEMICOLONS = 0; # Revision Notes # 09/20/01 - initial release # 10/24/01 - added error emails for flock and seek failures # 01/09/02 - changed email support to sendmail # Version Number # 1.2 # 2002 PayPal, Inc. and others. All rights reserved. # This code is subject to the Terms and Conditions in # the accompanying Beta Software License Agreement # User Constants - customize these to YOUR installation (see manual) # ------------------------------------------------------------------- # Set this to the path of your .htpassword file my $PASSWORD_FILE = '/home/bellinghamhosting/bellinghamhosting.com/ticker/users/users'; # Set this to the path of your processed_txns file my $TRANSACTION_FILE = '/home/bellinghamhosting/bellinghamhosting.com/ticker/users/processed_txns'; # You only need to change this if you are running with https # see the manual for details my $PAYPAL_URL = 'http://www.paypal.com/cgi-bin/webscr'; # If you have an initial trial period set it here. For example one # month would be '1 M' my $PERIOD1 = '1 M'; # Set this to the dollar amount for your initial trial period. For # example a free trial would be '0.00' my $AMOUNT1 = '25.00'; # Set this to the path of sendmail. On Linux and FreeBSD systems this # is typically '/usr/sbin/sendmail', on Solaris systems it is usually # found at '/usr/lib/sendmail' my $SENDMAIL_PATH = '/usr/sbin/sendmail'; # Set this to the email address you'd like to have error notification # messages sent to my $ADMIN_EMAIL = 'admin@imgthis.com'; # Set this to your primary PayPal email address my @PAYMENT_EMAILS = ('pay@imgthis.com'); # ------------------------------------------------------------------- main(); sub main { # acknowlege the ipn from PayPal if (ack_ipn()) { # decide what to do with msg received handle_ipn(); } # IPN was successfully processed respond(1); } sub ack_ipn { # ack the ipn my $ua = new LWP::UserAgent; # build the request my $req = new HTTP::Request("POST", $PAYPAL_URL); $req->content_type("application/x-www-form-urlencoded"); $req->content(query_string() . "&cmd=_notify-validate"); # get the response my $resp = $ua->request($req); if (($resp->is_success) && ($resp->content eq "VERIFIED")) { return 1; } else { # attempt to identify error if (($resp->is_success) && ($resp->content eq "INVALID")) { error_notify("Notification received was NOT from PayPal - Message was ignored.", "acknowledge IPN", 0, 0); } else { error_notify("Notification could not be acknowledged due to a network or PayPal issue. " ."PayPal will retry until it succeeds.", "acknowledge IPN", 1, 0); } return undef; } } sub handle_ipn { # handle the msg received if ((param("txn_type") eq "subscr_signup") && (validate_signup())) { # make sure a username was sent if (!param("username")) { error_notify("No username found. Check your subscription button or link.", "add user", 0, 1); return; } # add subscriber to password file add_user(param("username"), param("password"), param("subscr_id")); } elsif (param("txn_type") eq "subscr_eot") { # make sure a username was sent if (!param("username")) { error_notify("No username found. Check your subscription button or link.", "remove user", 0, 1); return; } # remove subscriber from password file remove_user(param("username")); } else { # ignore message } } sub validate_signup { # validate the terms and amounts if ((param("period1") ne $PERIOD1) || (param("amount1") ne $AMOUNT1)) { error_notify("This customer did not sign-up according to your payment terms. " . "Although payment was accepted the account was not activated.", "validate subscription terms", 0, 1); return undef; } # validate the receiver email my $valid = undef; foreach (@PAYMENT_EMAILS) { if (param("receiver_email") eq $_) { $valid = 1; } } if (!$valid) { error_notify("An IPN was received that did not match your primary email " . "address - Message was ignored.", "validate receiver email ", 0, 0); return undef; } file_open($TRANSACTION_FILE, "+<"); # validate transaction id if (find_txn(param("subscr_id"))) { # transaction was previously processed file_close($TRANSACTION_FILE); error_notify("An IPN was received that was already processed " . "- Message was ignored.", "validate subscription id", 0, 0); return undef; } else { file_close($TRANSACTION_FILE); } return 1; } sub error_notify { # sends notification that an error has occured my $err_str = shift; my $action = shift; my $kill = shift; my $req_action = shift; my $message = "The following error message was generated while trying to $action: \n\t$err_str\n\n\n"; $message .= "User Information\n"; $message .= "\tSubscriber's Username: " . param("username") . "\n"; $message .= "\tSubscriber's Email: " . param("payer_email") . "\n"; $message .= "\tSubscription Number: " . param("subscr_id") . "\n"; $message .= "\tTransaction Type: " . param("txn_type") . "\n"; $message .= "\t Param Recieved: " . param("period1") . " and param needed: " . $PERIOD1 . "\n"; my $subject = "Subscription Error"; if ($req_action) { $subject .= " - Requires Action"; } else { $subject .= " - No Action Required"; } # if an email is not specified write to error_log only if (($ADMIN_EMAIL) && ($SENDMAIL_PATH)) { my %mail = ( To => $ADMIN_EMAIL, From => $ADMIN_EMAIL, Subject => $subject, Message => $message, ); sendmail(%mail); } # put it into the error log if ($kill) { # IPN will retry respond(0); croak $message; } else { carp $message; } } sub sendmail { # send email using sendmail my %mail; my $key; while (@_) { $key = shift @_; $mail{$key} = shift @_; } if (!open(SENDMAIL, "|$SENDMAIL_PATH -t")) { carp "Unable to open sendmail pipe."; } print SENDMAIL "To: $mail{'To'}\n"; print SENDMAIL "From: $mail{'From'}\n"; print SENDMAIL "Subject: $mail{'Subject'}\n"; print SENDMAIL "Content-type: text/plain\n\n"; print SENDMAIL "$mail{'Message'}"; if (!close(SENDMAIL)) { carp "Unable to close sendmail pipe."; } } sub file_open { my $open_file = shift; my $open_str = shift; # open the file if (!open(FILE, "$open_str$open_file")) { error_notify("Unable to access: $open_file - $!\n", "open file", 1, 1); } # lock access to this file if (!flock(FILE, 2)) { error_notify("Unable to get lock on file: $open_file\n", "open file", 1, 1); } if (!seek(FILE, 0, 0)) { error_notify("Unable to seek to the start of the file: $open_file\n", "open file", 1, 1); } } sub file_close { my $close_file = shift; # unlock the file if (!flock(FILE, 8)) { error_notify("Unable to unlock file: $close_file\n", "close file", 1, 1); } if (!close(FILE)) { error_notify("Unable to close: $close_file - $!\n", "close file", 0, 0); } } sub find_login { my $new = shift; my $login; my $password; my $remainder; # for each line, break into parts while() { chop; ($login, $password, $remainder) = split(/:/, $_, 3); if ($login eq $new) { return 1; } } return undef; } sub find_txn { my $new_txn = shift; # look for this txn id while() { if (/^$new_txn/) { return 1; } } return undef; } sub add_user { my $login = shift; my $password = shift; my $txn = shift; file_open($PASSWORD_FILE, "+<"); # check to see if this user already exists if (find_login($login)) { error_notify("Username: $login already exists", "add user", 0, 1); } else { # seek to the end of the file if (!seek(FILE, 0, 2)) { error_notify("Unable to seek to the end of the file: $PASSWORD_FILE\n", "add user", 1, 1); } # add the necessary line print FILE "$login\:$password\n"; } file_close($PASSWORD_FILE); file_open($TRANSACTION_FILE, "+<"); # seek to the end of the file if (!seek(FILE, 0, 2)) { error_notify("Unable to seek to the end of the file: $TRANSACTION_FILE\n", "add user", 1, 1); } # add the necessary line print FILE "$txn\n"; file_close($TRANSACTION_FILE); } sub remove_user { my $login = shift; my @others; file_open($PASSWORD_FILE, "+<"); while() { if (!/^$login\:/) { # stuff lines into array push(@others, $_); error_notify("@others\n", "remove user fails", 1, 1); } } if (@others) { # seek to start of file if (!seek(FILE, 0, 0)) { error_notify("Unable to seek to the start of the file: $PASSWORD_FILE\n", "remove user", 1, 1); } # write out all the users foreach (@others) { print FILE $_; } # truncate the file to the current position truncate(FILE, tell(FILE)); } file_close($PASSWORD_FILE); } sub respond { # handle the http reponse my $is_success = shift; if ($is_success) { print header(-status=>('204 No Content')); } else { print header(-status=>('500 Internal Server Error')); } }