#!/usr/sww/bin/perl # ####################################################### # Power List version 1.5 # # Created by: Solution Scripts # Email: solutions@solutionscripts.com # Web: http://solutionscripts.com # ####################################################### # # # COPYRIGHT NOTICE: # # Copyright 1997-2000 Solution Scripts All Rights Reserved. # # This program is being distributed as freeware. It may be used and # modified free of charge, so long as this copyright notice, the header # above and all the footers in the program that give us credit remain # intact. Please also send us an email, and let me know # where you are using this script. # # By using this program you agree to indemnify Solution Scripts from any liability. # # Selling the code for this program without prior written consent is # expressly forbidden. Obtain permission before redistributing this # program over the Internet or in any other medium. In all cases # copyright and header must remain intact. # ###################################################### ########### YOU MUST CHANGE THE FOLLOWING ########## $name_list = "EE249: Design of Embedded Systems"; # THE NAME OF YOUR MAILING LIST $your_email = "apinto\@eecs.berkeley.edu"; # YOUR EMAIL ADDRESS # don't forget the \ before @ $your_name = "[EE249] Alessandro Pinto"; # YOUR NAME # Will show up in the from field # of all emails sent $name_url ="http://www-cad.eecs.berkeley.edu/~polis/class"; #THE URL OF YOUR SITE $name_home = "EE249"; #YOUR COMPANY OR SITE NAME $mail_prog = "/usr/lib/sendmail"; # PATH TO MAILER PROGRAM: # This has to point to your sendmail program. If your server does not # have sendmail, you may need to modify the open(MAIL,"|$mailprog -t"); # lines in all of the scripts to support whatever format your server # email system requires. If you are not sure, ask your server # administrator. If you have a virtual domain with your own root # directory, look in the /usr/sbin , /usr/lib, /usr/bin, and similar # directories, for a program named sendmail. If it does not exist, # ask your server admin what is the correct calling method. This is a # server dependent problem, and we at Solution Scripts cannot help you with # this. If you have other working scripts that send email, look at # them for clues. $remove_link = 1; # This will put a link at the bottom of all emails sent out, where a user can click on # to automatically be removed from your mailing list. Set to 1 for on, 0 for off. ################################### ## ADVANCED CONFIGURATION ## ################################### ## COLOR OPTIONS ## # The following five variables allow you to customize the look of Power List # by changing the colors of the table backgrounds and the text throughout the # Script. Simply enter the color desired, either by name or its hex number # ie: "white" or "#FFFFFF" $table_head_bg = "DARKSLATEBLUE"; # Background color of the small header row of the table $table_head_text = "white"; # Color of the text in the table header $table_body_bg = "#C0C0C0"; # Background color of the main body of the table $table_body_text = "black"; # Color of the text in the body of the table $body_tag = qq~ ~; # Body tag used throughout the program. Change the body tag to however # you like. $data_path = ""; # (OPTIONAL) # Directory path to where you want the two data files stored. # EXAMPLE - $data_path = "/home/httpd/html/powerlist"; $address_file = ""; # (OPTIONAL) # Name of file where email addresses are stored. # If left blank, address.txt is used. # EXAMPLE - $address_file = "emailsaddrs.txt"; ############################################################################## # CHANGE NO MORE $version = "1.5"; $thisurl = $ENV{'SCRIPT_NAME'}; $mail_url = $ENV{'SERVER_NAME'}; $address_file = "address.txt" unless $address_file; $pwd_file = "password.txt" unless $pwd_file; $address_file = "$data_path/$address_file" if $data_path; $pwd_file = "$data_path/$pwd_file" if $data_path; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; if ($INPUT{$name}) { $INPUT{$name} = $INPUT{$name}.",".$value; } else { $INPUT{$name} = $value; } } unless ($INPUT{'email'}) { print "Content-type: text/html \n\n"; &Top; } $temp=0; $temp=$ENV{'QUERY_STRING'}; if ($temp) { $INPUT{'address'} = $temp; &remove; } if ($INPUT{'email'}) { &email; } elsif ($INPUT{'action'} eq "subscribe") { &subscribe; } elsif ($INPUT{'action'} eq "remove") { &remove; } elsif ($INPUT{'newpass'}) { &newpass; } elsif ($INPUT{'delete_select'}) { &delete_select; } elsif ($INPUT{'delete_final'}) { &delete_final; } elsif ($INPUT{'sendemail'}) { &sendemail; } elsif ($INPUT{'address'}) { &subscribe; } else { &admin; } exit; ########### MAIN ADMIN SCREEN ########## sub admin { open (PASSWORD, "$pwd_file"); $password = ; close (PASSWORD); chop ($password) if ($password =~ /\n$/); if (!$password) { print qq~
Set Admin Password

Before you can do anything else, you'll need to set your administrative password. This will allow you to use the administrative functions,
Please enter your desired password below. (Enter it twice.)

~; &Bottom; exit; } $numemail=0; open(LIST,"$address_file"); @addresses=; close(LIST); $numemail = push(@addresses); print qq~
Add or remove an email address


Subscribe | Unsubscribe



Admin Functions

Send out an email to $numemail emails


Delete selected addresses from database


Enter admin password
Needed for both of above

~; &Bottom; exit; } ########## SET NEW PASSWORD ########## sub newpass { unless ($INPUT{'passad'} eq $INPUT{'passad2'}) { print qq~
Error!!

Your administrative password was not set, as the two entries were different!
~; &Bottom; exit; } if ($INPUT{'passad'}) { $newpassword = crypt($INPUT{'passad'}, aa); } else { print qq~
Error!!

You must enter a password!
~; &Bottom; exit; } if (-e "$pwd_file") { print qq~
Error!!

Password already exists

To set a new password manually delete the
$pwd_file file
~; &Bottom; exit; } open (PASSWORD, ">$pwd_file") || &error(1); print PASSWORD "$newpassword"; close (PASSWORD); print qq~
Password Set

Your administrative password has been set.

~; &admin; exit; } ########## SUBSCRIBE NEW EMAILS ########## sub subscribe { unless ($INPUT{'address'}=~/\@/) { &error_pretty("You entered an invalid email address, please go back and try again"); } open(LIST,"$address_file"); @addresses=; close(LIST); @add = grep{ /$INPUT{'address'}/i } @addresses; if (@add) { &error_pretty("The address you entered, $INPUT{'address'} is already in our mailing list"); } open(LIST,">>$address_file") || &error(2); print LIST "$INPUT{'address'}\n"; close(LIST); print qq~
Email successfully added!!

Thank you for your interest

The address $INPUT{'address'} has been added to our mailing list.

Return to $name_home
~; &Bottom; exit; } ########## REMOVE ADDRESSES ########## sub remove{ unless ($INPUT{'address'}) { &error_pretty("You must enter an address to be removed"); } if (-e "$address_file") { &lock($address_file); open(LIST, "+<$address_file"); @addresses = ; seek (LIST, 0, 0); truncate (LIST,0); foreach $add(@addresses) { chomp($add); unless ($add =~ /^$INPUT{'address'}$/i) { print LIST "$add\n"; } else { $found=1; } } close(LIST); &unlock($address_file); } print qq~
Email successfully removed

We are sorry to see you go

The address $INPUT{'address'} has been removed from our mailing list

Return to $name_home
~; &Bottom; exit; } ########## SEND EMAILS ########## sub email { &checkpassword; #### $pid = fork(); print "Content-type: text/html \n\n fork failed: $!" unless defined $pid; if ($pid) { #parent print "Content-type: text/html \n\n"; &Top; print qq~
Email successfully sent!!


Emails sent
~; &Bottom; exit(0); } else { #child close (STDOUT); open(LIST,"$address_file"); @addresses=; close(LIST); $num_email=0; foreach $line(@addresses) { chomp($line); open(MAIL, "|$mail_prog -t") || &error("Could not send out emails"); print MAIL "To: $line \n"; print MAIL "From: $your_name <$your_email>\n"; print MAIL "Subject: $INPUT{'subject'} \n"; print MAIL "$INPUT{'body'}"; print MAIL "\n\n"; if ($remove_link) { print MAIL "-------------------------------------------------------------------------\n"; print MAIL "To be removed from this mailing list\n"; print MAIL "click on the link below \n"; print MAIL "http://$mail_url$thisurl?$line\n"; } print MAIL "\n\n"; close (MAIL); $num_email++; } open(MAIL, "|$mail_prog -t") || &error("Could not send out emails"); print MAIL "To: $your_email \n"; print MAIL "From: $your_name <$your_email>\n"; print MAIL "Subject: $INPUT{'subject'} \n"; print MAIL "$num_email were sent out with the following message \n\n"; print MAIL"-----------------------------------------------------------------------------------------\n"; print MAIL "$INPUT{'body'}"; print MAIL "\n\n"; print MAIL "\n\n"; close (MAIL); exit(0); } } ########## DELETE SELECTED EMAILS ########## sub delete_select { &checkpassword; open(LIST,"$address_file"); @addresses=; close(LIST); @addresses = sort(@addresses); print qq~
~; $num_email=0; foreach $line(@addresses) { chomp($line); if ($num_email == 3) { print ""; $num_email=0; } print ""; $num_email++; } print qq~
Select email to delete
"; print " -- $line
Enter your admin password


~; &Bottom; exit; } ########## DELETE MULTIPLE ########## sub delete_final { &checkpassword; open(LIST,"$address_file"); @addresses=; close(LIST); @deleting = split(/\,/,$INPUT{'delete'}); foreach $line(@deleting) { @addresses = grep{ !(/$line/i) } @addresses; } open(LIST,">$address_file") || &error(2); print LIST @addresses; close(LIST); $INPUT{'delete'} =~ s/\,/
\n/g; print qq~
Emails Removed
The following emails have been deleted from the database

$INPUT{'delete'}

~; &Bottom; exit; } ########## WRITE THE EMAIL ########## sub sendemail { &checkpassword; print qq~
Create email to send to all users
Subject


Body of Message

Admin Password:

~; &Bottom; exit; } ########## CHECK PASSWORD ########## sub checkpassword { open (PASSWORD, "$pwd_file"); $password = ; close (PASSWORD); if ($INPUT{'password'}) { $newpassword = crypt($INPUT{'password'}, aa); unless ($newpassword eq $password) { &error_pretty("Wrong Password"); } } else { &error_pretty("You must enter a password"); } } sub Top { print qq~ $name_list $body_tag
        $name_list        


~; } sub Bottom { print qq~

Power List v $version
Free from Solution Scripts


~; } sub error{ $errors = $_[0] ; if ($errors == 1) { $error_msg = "Unable to write to $pwd_file"; } else { $error_msg = "Unable to write to $address_file"; } print qq~
Fatal Error!!

$error_msg - $!

If the above error states "Permission Denied than either the dir this cgi file is in or the text file mentioned need to be chmoded to 777.

Do not worry if you do not have the file mentioned, once the permissions are set correctly it will be created for you.

If you are having trouble with this script
please post a message to the CGI Forum

~; &Bottom; exit; } sub error_pretty { $errors = $_[0]; print qq~
Error!!

$errors

Return to $name_home
~; &Bottom; exit; } ########## FILE LOCKING SUB ########## sub lock { my $file = $_[0]; my $etime = time + 5; if (-e "$file.lock") { open (LOCK,"$file.lock"); my $temp = ; close (LOCK); chomp ($temp); if ($temp < (time - 10)) { unlink ("$file.lock"); } } while (-e "$file.lock" && time < $etime) { sleep(1); } if (-e "$file.lock") { print "file lock still here $file.lock"; exit; } else { open (LOCKFILE, ">$file.lock"); print LOCKFILE time; close (LOCKFILE); } } ############ sub unlock { my $file = shift; unlink ("$file.lock"); } 1;