#!/usr/bin/perl
use CGI;
use Time::Local;
################################################
#
# Generic script for marriage postings !
#
# kishan@hackorama.com www.hackorama.com
# Released under GPL November 2000
#
################################################
$PUB = '/foo/bar/html' ;
$KGIBIN = 'http://www.foo.com/cgi-bin/greetings/' ;
$WEB = "http://www.foo.com";
$WEBURL = 'http://www.foo.com' ;
$ENABLEURL = "$WEB/greetings/enable/";
$SHOULDBE = "$WEB/$PROJ/edit.html" ;
$COULDBE = "$KGIBIN/$PROJ.cgi?whe=3" ;
$MAYBE = "$KGIBIN/$PROJ.cgi" ;
$files = "/foo/bar/foo/cgi-bin/greetings/files";
$bin = "/foo/bar/cgi-bin/greetings/bin";
$res = "/foo/bar/cgi-bin/greetings/res";
$listfile = "$res/projlist.txt";
$topfile = "$res/top.txt";
$botfile = "$res/bot.txt";
$pageonefile = "$res/one.txt";
$editfile = "$res/editit.txt";
$passfile = "$res/pass.txt";
$from = 'greetings@foo.com';
$replyto = 'greetings@foo.com';
$cc = 'marryfeed@foo.com';
$mailer = "HACKORAMA MAIL" ;
$sub = "Getmarried sign up !";
$mailfile = "$res/enable.txt";
### Usually no customisation beyond this ######
$q = CGI::new();
### get everything from the form
$page = $q->param("page"); chomp($page);
$groom = $q->param("groom"); chomp($groom);
$bride = $q->param("bride"); chomp($bride);
$proj = $q->param("proj"); chomp($proj);
$proj =~ s/\s//g;
$proj = lc($proj);
$proj =~ s/([^a-z])/-/g;
$mail = $q->param("mail"); chomp($mail);
$pass = $q->param("pass"); chomp($pass);
$inv = $q->param("inv"); chomp($inv);
$thanks = $q->param("thanks"); chomp($thanks);
$code = $q->param("code"); chomp($code);
$inv =~s/
/ /g;
$thanks =~s/
/ /g;
process();
sub blacken()
{
$groom_col = 'black';
$bride_col = 'black';
$proj_col = 'black';
$mail_col = 'black';
$pass_col = 'black';
$inv_col = 'black';
$thanks_col = 'black';
}
sub checkit()
{
$flag = 0;
$groom_col = 'black';
$bride_col = 'black';
$proj_col = 'black';
$mail_col = 'black';
$pass_col = 'black';
$inv_col = 'black';
$thanks_col = 'black';
if( $mail =~ ".+@.+" ){
$mail_col = 'black';
} else {
$mail_col = 'red' ;
$flag = 1;
}
if( $bride eq "" ){
$bride_col = 'red' ;
$flag = 1;
}
if( $groom eq "" ){
$groom_col = 'red' ;
$flag = 1;
}
if( $proj eq "" ){
$proj_col = 'red' ;
$flag = 1;
} else {
$target = "$PUB/$proj";
if ( -e $target ){
$proj_col = 'red' ;
$flag = 2;
}
}
if( $pass eq "" ){
$pass_col = 'red' ;
$flag = 1;
}
if ( $flag > 0 ){
redflag();
exit;
}
}
sub stamp()
{
@MONTHS = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
($sec,$min,$hour,$monthday,$month,$year,$weekday,$yearday,$DST) = localtime(time);
$timestamp = timelocal($sec,$min,$hour,$monthday, $MONTHS[$month], $year);
}
sub getRandChar
{
local ($string) = @_;
return substr($string, (int rand(32767)) % length($string), 1);
}
sub uniq()
{
local $lower = "bcdfghjklmnprstvwxyz";
local $upper = "BCDFGHJKLMNPRSTVWXYZ";
local $lv = "aeiou";
local $uv = "AEIOU";
local $result;
srand(time);
$result .= getRandChar($lower);
$result .= getRandChar($uv);
$result .= getRandChar($upper);
$result .= getRandChar($lv);
$result .= getRandChar($lower);
$result .= getRandChar($uv);
$result .= int rand(10);
$result .= int rand(10);
return $result;
}
sub process()
{
if ( $page == 1 ){
checkit();
process_page_one();
} elsif ( $page == 2 ){
process_page_two();
} elsif ( $page == 3 ){
ask_pass();
} elsif ( $page == 4 ){
check_pass();
} elsif ( $page == 5 ){
let_edit();
} elsif ( $page == 6 ){
update_all();
} else {
go_away();
}
exit;
}
sub update_all()
{
}
sub process_page_two()
{
validate();
if( $enabled == 1) {
print_enabled();
} else {
kreate();
feedback_two();
}
}
sub check_pass()
{
$found = 0;
if( ($mail eq "") || ($pass eq "") ){
tryagain();
exit;
}
open ( LISTFILE , "<$listfile") || return 0;
flock( LISTFILE, 2 ) or die "cannot lock file: $!";
while(<LISTFILE>){
$line = $_;
chomp($line);
($nu_mail, $nu_code, $storefile , $nu_pass ) = split(':K1973:', $line );
chomp( $nu_mail );
chomp( $nu_code );
chomp( $storefile );
chomp( $nu_pass );
if ( ($nu_mail eq $mail) && ( $nu_pass eq $pass) ){
$found = 1;
}
}
close (LISTFILE);
if( $found == 1){
fetch();
welcome()
} else {
tryagain();
exit;
}
}
sub validate()
{
$found = 0;
open ( LISTFILE , "<$listfile") || return 0;
flock( LISTFILE, 2 ) or die "cannot lock file: $!";
while(<LISTFILE>){
$line = $_;
chomp($line);
($nu_mail, $nu_code, $storefile , $pass ) = split(':K1973:', $line );
chomp( $nu_mail );
chomp( $nu_code );
chomp( $storefile );
chomp( $pass );
if ( ($nu_mail eq $mail) && ( $nu_code eq $code) ){
$found = 1;
}
}
close (LISTFILE);
if( $found == 1){
fetch();
$target = "$PUB/$proj";
if ( -e $target ){
$enabled = 1 ;
}
} else {
go_away();
exit;
}
}
sub fetch()
{
$reading = 0;
open ( LISTFILE , "<$files/$storefile") || return 0;
flock( LISTFILE, 2 ) or die "cannot lock file: $!";
while(<LISTFILE>){
$line = $_;
chomp($line);
if( $reading == 0 ){
( $proj, $groom, $bride , $mail) = split(':K1973:', $line );
$reading = 1;
} elsif ( $reading == 1 ){
if( $line eq 'K1973INVK1973' ){
$reading = 2;
}
} elsif ($reading == 2 ) {
if( $line eq 'K1973THANKSK1973' ){
$reading = 3;
} else {
$inv .= $line ;
}
} elsif ($reading == 3 ) {
$thanks .= $line ;
}
}
close (LISTFILE);
}
sub kreate()
{
system "mkdir $PUB/$proj";
$fromfile = "$res/main.php3";
$tofile = "$PUB/$proj/main.php3";
filterout();
$fromfile = "$res/side.shtml";
$tofile = "$PUB/$proj/side.shtml";
filterout();
$fromfile = "$res/index.html";
$tofile = "$PUB/$proj/index.html";
filterout();
$fromfile = "$res/adameve.cgi";
$tofile = "$bin/$proj.cgi";
filterout();
#open ( THANKSFILE , ">$PUB/$proj/mail.txt") || return 0;
#while(<THANKSFILE>){
####print THANKSFILE "Dear KNAME ,\n\n";
#print THANKSFILE $thanks;
#####print THANKSFILE "Thank You\nKGROOM and KBRIDE\n " ;
####print THANKSFILE "\nPlease go to KLOC \n to view yours as well as other \n newly posted messages\n";
#}
#close (THANKSFILE);
system "chmod a+x $bin/$proj.cgi";
}
sub ask_pass()
{
print $q->header();
$q->print("<HTML>");
$q->print("<BODY BGCOLOR=WHITE><center>");
if ( $passfailed == 1){
$q->print("<font face=helvetica color=red size=-2> The Email/Password combination you entered does not match ! </font>");
}
print_pass();
$q->print("</BODY>");
$q->print("</HTML>");
}
sub print_enabled()
{
print $q->header();
$q->print("<HTML>");
print_top();
$q->print("<BODY BGCOLOR=WHITE><center>");
$q->print("Your marriage site is already activated \n please go to <A HREF=\"$WEBURL/$proj\" target=_top>$WEBURL/$proj</a>");
$q->print("</BODY>");
print_bot();
$q->print("</HTML>");
}
sub process_edit()
{
}
sub welcome()
{
print $q->header();
$q->print("<HTML>");
$q->print("<BODY BGCOLOR=WHITE><center>");
$q->print("<table bgcolor=#dadeed cellpadding=10 cellspacing=10> <tr><td>");
$q->print("<font face=helvetica size=-2>");
$q->print("<A STYLE=\"text-decoration:none\" HREF=\"$KGIBIN/bin/$proj.cgi?whe=3\"> CHECK NEW MESSAGES </A> <br><br>");
$q->print("<A STYLE=\"text-decoration:none\" HREF=\"$KGIBIN/cochin.cgi?page=5&mail=$mail&code=$nu_code\"> EDIT PROFILE </A>");
$q->print("</font>");
$q->print("</td></tr></table>");
$q->print("</BODY>");
$q->print("</HTML>");
}
sub tryagain()
{
$passfailed = 1;
ask_pass();
}
sub process_page_one()
{
stamp();
$code .= uniq();
$filename = "$proj-$timestamp" ;
store();
feedback();
storeall();
mailit();
}
sub store()
{
open ( LISTFILE , ">>$listfile") || return 0;
flock( LISTFILE, 2 ) or die "cannot lock file: $!";
print LISTFILE "$mail:K1973:$code:K1973:$filename:K1973:$pass\n";
close (LISTFILE);
}
sub storeall()
{
open ( STORE , ">$files/$filename") || return 0;
flock( STORE, 2 ) or die "cannot lock file: $!";
print STORE "$proj:K1973:$groom:K1973:$bride:K1973:$mail\n" ;
print STORE "K1973INVK1973\n" ;
print STORE "$inv\n" ;
print STORE "K1973THANKSK1973\n" ;
print STORE "$thanks\n" ;
close( STORE );
}
sub go_away()
{
print $q->header();
$q->print("<HTML>");
print_top();
$q->print("<BODY BGCOLOR=WHITE><center>");
$q->print("The Email/Code combination you entered does not match !");
$q->print("");
print_bot();
$q->print("<HTML>");
}
sub get_env()
{
$IP = $ENV{'REMOTE_ADDR'};
$REF = $ENV{'HTTP_REFERER'};
}
sub redflag()
{
print $q->header();
$q->print("<HTML>");
print_top();
$q->print(" The values marked <font color=red> red </font> are not correct ! <br>");
if( $flag == 2 ){
$q->print("<br>The pagename you chose \"<font color=red>$proj</font>\" already exists, please select another pagename!<br>");
}
print_one();
print_bot();
$q->print("</HTML>");
}
sub let_edit()
{
##validate();
print $q->header();
$q->print("<HTML>");
$q->print("<BODY BGCOLOR=white>");
$q->print("<br><br>We are sorry, this feature is not supported in this version.");
$q->print("Please send a mail to <A HREF=mailto:greetings\@foo.com > greetings\@foo.com</a> for support <br>");
##$q->print(" Please edit the values you entered <br>");
##print_edit();
$q->print("</BODY>");
$q->print("</HTML>");
}
sub feedback()
{
print $q->header();
$q->print("<HTML>");
print_top();
$q->print("<font face=helvetica size=-2>");
$q->print("Thank you $groom and $bride ");
$q->print("We have a sent an email to $mail with info on");
$q->print(" how to activate your marriage site!");
$q->print("<br><br> <a STYLE=\"text-decoration:none\" href=\"$WEB/greetings\" > BACK TO GETMARRIED HOME </a>");
$q->print("</font>");
print_bot();
$q->print("</HTML>");
}
sub feedback_two()
{
print $q->header();
$q->print("<HTML>");
print_top();
$q->print("Thank you $groom and $bride ");
$q->print("Your marriage site is activated \n please go to <A HREF=\"$WEBURL/$proj\" target=_top>$WEBURL/$proj</a>");
$q->print("<br><br>Please send your pictures as attachment to <A HREF=\"mailto:greetings\@hackorama.com\">greetings\@hackorama.com</a>, which will be processed and posted on your site for free");
print_bot();
$q->print("</HTML>");
}
sub print_top()
{
$coverfile = $topfile;
print_cover();
}
sub print_bot()
{
$coverfile = $botfile;
print_cover();
}
sub print_pass()
{
$cgiscript = "$KGIBIN/cochin";
open ( COVER , "<$passfile") || return 0;
while(<COVER>){
$myline = $_;
$myline =~ s/COCHIN/$cgiscript/g;
$q->print("$myline");
}
close (COVER);
}
sub print_cover()
{
open ( COVER , "<$coverfile") || return 0;
while(<COVER>){
$myline = $_;
$q->print("$myline");
}
close (COVER);
}
sub filterout()
{
open ( FROM , "<$fromfile") || return 0;
open ( TO , ">$tofile") || return 0;
while(<FROM>){
$myline = $_;
$myline =~ s/K1973GROOM/$groom/g;
$myline =~ s/KGROOM/$groom/g;
$myline =~ s/K1973BRIDE/$bride/g;
$myline =~ s/KBRIDE/$bride/g;
$myline =~ s/KPROJ/$proj/g;
$myline =~ s/K1973PROJ/$proj/g;
$myline =~ s/KGIBIN/$KGIBIN/g;
$myline =~ s/KWEB/$WEBURL/g;
$myline =~ s/KINV/$inv/g;
print TO "$myline";
}
close (FROM);
close (TO);
}
sub print_edit()
{
open ( COVER , "<$editfile") || return 0;
while(<COVER>){
$myline = $_;
$myline =~ s/KGROOM/$groom/g;
$myline =~ s/KBRIDE/$bride/g;
$myline =~ s/KPROJ/$proj/g;
$myline =~ s/KINVITE/$inv/g;
$myline =~ s/KTHANKS/$thanks/g;
$myline =~ s/KINVCOL/black/g;
$myline =~ s/KTHACOL/black/g;
$q->print("$myline");
}
close (COVER);
}
sub print_one()
{
open ( COVER , "<$pageonefile") || return 0;
while(<COVER>){
$myline = $_;
$myline =~ s/KMAIL/$mail/g;
$myline =~ s/KGROOM/$groom/g;
$myline =~ s/KBRIDE/$bride/g;
$myline =~ s/KPASS/$pass/g;
$myline =~ s/KPROJ/$proj/g;
$myline =~ s/KINVITE/$inv/g;
$myline =~ s/KTHANKS/$thanks/g;
$myline =~ s/KGROCOL/$groom_col/g;
$myline =~ s/KBRICOL/$bride_col/g;
$myline =~ s/KMAICOL/$mail_col/g;
$myline =~ s/KPROCOL/$proj_col/g;
$myline =~ s/KINVCOL/$inv_col/g;
$myline =~ s/KTHACOL/$thanks_col/g;
$myline =~ s/KPASCOL/$pass_col/g;
$q->print("$myline");
}
close (COVER);
}
sub mailit()
{
$myline;
open ( MSG , "<$mailfile") || return 0;
flock ( MSG , 2 ) or die "cannot lock file exclusively: $!";
open (SENDMAIL, "|/usr/sbin/sendmail -t") or die "cannot open sendmail: $!";
print SENDMAIL "X-Mailer: $mailer\n";
print SENDMAIL "To: $mail\n";
print SENDMAIL "From: $from\n";
print SENDMAIL "Reply-To: $replyto\n";
print SENDMAIL "Bcc: $cc\n";
print SENDMAIL "Subject: $sub\n\n";
while(<MSG>){
$myline = $_;
$myline =~ s/KCODE/$code/g;
$myline =~ s/KMAIL/$mail/g;
$myline =~ s/KGROOM/$groom/g;
$myline =~ s/KBRIDE/$bride/g;
$myline =~ s/KLOC/$ENABLEURL/g;
print SENDMAIL "$myline";
}
print SENDMAIL "\n";
print SENDMAIL ".";
close MSG;
}
syntax highlighted by Code2HTML, v. 0.9