#!/usr/bin/perl ########################################################### # # Master Reciprocal Links # Version 1.2 # (Submission Form section) # Version 1.0 Created September 17, 2000 # Version 1.2 Completed December 5, 2002 # Author: William Bontrager # Author's Site: http://willmaster.com # Author's Email: william@willmaster.com # # Copyright 2000-2002 William Bontrager # # This custom version downloaded # from # for australian-images.com # by 128.121.218.30 # at 1059539817 -- Tuesday, July 29, 2003 at 22:36:57. # # To install or use Master Recriprocal Links, you # must agree not to edit this program code in any # way that alters the display of this program's name, # banners, advertising, copyright statements, and/or # author's name. # # You must agree to the License Agreement located at # http://willmaster.com/master/LicenseAgreement.html # before installing or using Master Reciprocal Links. # # A copy of the License Agreement might have been included # in your download package. It is your responsibility to # verify that what you received is the same as the one at # http://willmaster.com/master/LicenseAgreement.html # ########################################################## # # NOTE: If you received this from a source other than a # Master Reciprocal Links program generation site, # it is highly recommended that you go to a program # generation site and generate a custom copy. # # A list of Master Reciprocal Links program generation # sites is at http://willmaster.com/master/rlinks/ # ########################################################## require 5; use LWP::Simple; $MaximumNumberOfCharactersInTheTitle = 80; $WorkDirectory = 'mrldata'; $LinksDatabase = 'links.db'; $SubsDatabase = 'subs.db'; $ConfigDatabase = 'config.db'; $SelfDurl = 'http://australian-images.com/cgi-bin/'; $SelfURL = 'http://australian-images.com/cgi-bin/mrlsf.cgi'; $ServerMailer = '/usr/lib/sendmail-t'; $PublicName = 'M a s t e r   R e c i p r o c a l   L i n k s'; $TitleTagPublicName = 'Master Reciprocal Links'; %ConfigLines = ( front => 0, 'linkspageformat' => 1, 'fontfacedefault' => 2, 'fontfacesans' => 3, 'fontfaceserif' => 4, 'fontfaceother' => 5, 'fontfaceothertext' => 6, 'fontsizedefault' => 7, 'fontsizeplus' => 8, 'fontsizeminus' => 9, 'fontsizeother' => 10, 'fontsizeothertext' => 11, 'sortontitle' => 12, 'sortonurl' => 13, 'sortalpha' => 14, 'sortrevalpha' => 15, 'sortnewtop' => 16, 'sortoldtop' => 17, 'sortpseudo' => 18, 'breakbetweennever' => 19, 'breakbetweenalways' => 20, 'breakbetweencustom' => 21, 'breakbetweennum' => 22, 'breakcategorynever' => 23, 'breakcategorycustom' => 24, 'breakcategorynum' => 25, 'destinationlinkpage' => 26, 'notifyaddy' => 27, 'notifysubject' => 28, 'blank0' => 29, 'blank1' => 30, 'blank2' => 31, 'blank3' => 32, 'blank4' => 33, 'blank5' => 34, 'blank6' => 35, 'blank7' => 36, 'blank8' => 37, 'blank9' => 38, 'blank10' => 39, 'blank11' => 40, 'blank12' => 41, 'blank13' => 42, 'blank14' => 43, 'blank15' => 44, 'blank16' => 45, 'blank17' => 46, 'blank18' => 47, 'blank19' => 48, 'blank20' => 49, 'blank21' => 50, 'blank22' => 51, 'blank23' => 52, 'blank24' => 53, 'blank25' => 54, 'blank26' => 55, 'blank27' => 56, 'blank28' => 57, 'blank29' => 58, 'titlemaxpunctuation' => 59, 'titleminimumlength' => 60, 'titlelength' => 61, 'titlecapspercentage' => 62, 'titlecapswords' => 63, 'titlebannedlist' => 64, 'remotebannedlist' => 65, 'banneddomains' => 66, 'emailapprovedyes' => 67, 'emailapprovedno' => 68, 'emaildisapprovedyes' => 69, 'emaildisapprovedno' => 70, 'newwindowyes' => 71, 'newwindowno' => 72, 'linkpagetemplate' => 73, 'autoschedulepercent' => 74, 'autopercent' => 75, 'autoschedulenumber' => 76, 'autonumber' => 77, 'thankyoupageurl' => 78, 'linkfromremoteurl' => 79, 'linkfromremotetitle' => 80, 'blanka' => 81, 'blankb' => 82, 'blankc' => 83, 'blankd' => 84, 'blanke' => 85, 'blankf' => 86, 'blankg' => 87, 'blankh' => 88, 'blanki' => 89, 'blankj' => 90, 'blankk' => 91, 'blankl' => 92, 'blankm' => 93, 'blankn' => 94, 'blanko' => 95, 'blankp' => 96, 'blankq' => 97, 'roveraddy' => 98, 'roversubject' => 99, 'authorizeddomains' =>100, 'finis'=> 101); %DBfields = ( 'subdate' => 0, 'approvedate' => 1, 'moddate' => 2, 'linkfromurl' => 3, 'linktourl' => 4, 'linktotitle' => 5, 'emaili' => 6, 'description' => 7, 'message' => 8, 'blank0' => 9, 'blank1' => 10, 'blank2' => 11, 'blank3' => 12, 'blank4' => 13, 'blank5' => 14, 'blank6' => 15, 'blank7' => 16, 'blank8' => 17, 'blank9' => 18, 'blank10' => 19, 'blank11' => 20, 'blank12' => 21, 'blank13' => 22, 'blank14' => 23, 'blank15' => 24, 'blank16' => 25, 'blank17' => 26, 'blank18' => 27, 'blank19' => 28, 'blank20' => 29, 'blank21' => 30, 'blank22' => 31, 'blank23' => 32, 'blank24' => 33, 'blank25' => 34, 'blank26' => 35, 'blank27' => 36, 'blank28' => 37, 'blank29' => 38, 'finis' => 39); $AuthorizedDomain = 'australian-images.com'; &ParseFormData; if(open R,"$WorkDirectory\/$ConfigDatabase") { @TA = ; close R; chomp @TA; $TA[$ConfigLines{finis}] = '' if $#TA < $ConfigLines{finis}; @BannedList = split /\t/,$TA[$ConfigLines{titlebannedlist}]; } ErrorHTML('The Links Page Maintainer has not yet used the control panel to specify both the URL and the title of a page for you to link to.') unless $TA[$ConfigLines{linkfromremoteurl}] =~ /\w/ and $TA[$ConfigLines{linkfromremotetitle}] =~ /\w/; &PresentForm unless $In{fromform} and &ValidDomain; &VerifySubmission; &MailToWebmaster; &StoreInSubmissionsDatabase; &ThankYouPage; exit; sub StoreInSubmissionsDatabase { if(length($In{description}) > 3072) { $In{description} = substr($In{description},0,3072) . "\n[OVER-SIZED DESCRIPTION CHOPPED AT THIS POINT]\n"; } if(length($In{message}) > 3072) { $In{message} = substr($In{message},0,3072) . "\n[OVER-SIZED MESSAGE CHOPPED AT THIS POINT]\n"; } unless(-e "$WorkDirectory\/$SubsDatabase") { open W,">$WorkDirectory\/$SubsDatabase"; close W; } $In{description} =~ s/\A\s*//; $In{description} =~ s/\s*\Z//; if($In{description} =~ /\w/) { $In{description} =~ s/\r//g; $In{description} =~ s/ +/ /g; $In{description} =~ s/\n +\n/\n\n/gs; $In{description} =~ s/\n\n+/\n\n/g; $In{description} =~ s/\n\n/\/g; $In{description} =~ s/\n/\/g; } $In{message} =~ s/\A\s*//; $In{message} =~ s/\s*\Z//; if($In{message} =~ /\w/) { $In{message} =~ s/\r//g; $In{message} =~ s/ +/ /g; $In{message} =~ s/\n +\n/\n\n/gs; $In{message} =~ s/\n\n+/\n\n/g; $In{message} =~ s/\n\n/\/g; $In{message} =~ s/\n/\/g; } my @rec; for(keys %DBfields) { $rec[$DBfields{$_}] = $In{$_}; } $rec[$DBfields{finis}] = ''; $rec[$DBfields{subtime}] = time; my $rec = join "\t",@rec; LockFile("$WorkDirectory\/$SubsDatabase"); unless(open W,">>$WorkDirectory\/$SubsDatabase") { UnLockFile("$WorkDirectory\/$SubsDatabase"); ErrorHTML('Unable to open a critical file. You may wish to click your browser\'s "back" button and try again.'); } print W "$rec\n"; close W; UnLockFile("$WorkDirectory\/$SubsDatabase"); } # sub StoreInSubmissionsDatabase sub MailToWebmaster { return unless ValidEmail($TA[$ConfigLines{notifyaddy}]); my $desc = $In{description} =~ /\w/ ? "\nTheir Site Description:\n$In{description}\n" : ''; #open MAIL,">t"; open MAIL,"|$ServerMailer"; print MAIL <\n$In{linkfromurl}\n\nOur link must be on your page before you use this form.") unless $p =~ m!\.*?\!is; } else { push(@e,"The URL of your page where you have our link:\n
\n$In{linkfromurl}\n
\nappears to be invalid. At least, I can't find it."); } } else { push(@e,'Please provide the URL of your page where you have our link.'); } if($In{linktourl} =~ /\w/) { my $p = get $In{linktourl}; push(@e,"The URL of the page you want us to link to:\n
\n$In{linktourl}\n
\nappears to be invalid. At least, I can't find it.") unless $p; } else { push(@e,'Please provide the URL of the page you want us to link to.'); } if($In{linktotitle} =~ /\w/) { push(@e,'There appears to be a URL where the title is supposed to be.') if $In{linktotitle} =~ m!^https?://\w!i; my $i = $In{linktotitle} =~ tr///c; push(@e,"The maximum length for the page Title is 80 characters. Yours has $i.") if $i > 80; push(@e,'Please refrain from punctuation repitition in the Title.') if $In{linktotitle} =~ /[\?\!\.] *[\?\!]/ or $In{linktotitle} =~ /[\?\!] *[\?\!\.]/ or $In{linktotitle} =~ /([^\.]|\A)\.\.([^\.]|\Z)/ or $In{linktotitle} =~ /\.\.\.\./; $i = $In{linktotitle} =~ tr/a-zA-Z//; $i = 1 unless $i > 0; my $uc = $In{linktotitle} =~ tr/A-Z//; my $percentage = int((($uc / $i) * 100) + .5); my @ta = split /\s+/,$In{linktotitle}; my $ii = 0; for (@ta) { $i = tr/a-zA-Z//; next unless $i; $uc = tr/A-Z//; $ii++ if $uc >= $i; } push(@e,'Please reduce the capitalization in the Title.') if length($In{linktotitle}) > 6 and ($percentage >= 50 or $ii > 1); for(@BannedList) { next unless /\w/; my $Q_ = quotemeta $_; my $ts = tr/ // ? 'phrase' : 'word'; push(@e,"The $ts\:\n
\n$_\n
\nis not allowed on our links page.") if $In{linktotitle} =~ /(?:\A|\b)$Q_(?:\b|\Z)/i; } } else { push(@e,'Please provide the Title of the page you want us to link to'); } if($In{emaili} =~ /\w/) { push(@e,"Your email address:\n
\n$In{emaili}\n
\nappears to be invalid.") unless ValidEmail($In{emaili}); } else { push(@e,'Please provide your email address.'); } ErrorHTML(@e) if @e; } # sub VerifySubmission sub ValidDomain { return 0 unless $ENV{HTTP_REFERER}; my $ret = 0; my $ref = lc($ENV{HTTP_REFERER}); $ref =~ s/\A.*\/\///; $ref =~ s/\Awww\.//; $ref =~ s/\/.*?\Z//; $ret = 1 if $ref == $AuthorizedDomain; return $ret; } # ValidDomain sub ParseFormData { my @pairs; my $buffer; read(STDIN,$buffer,$ENV{CONTENT_LENGTH}); @pairs = split(/&/,$buffer); my ($n,$v); foreach $t (@pairs) { ($n,$v) = split(/=/,$t); $n =~ tr/+/ /; $v =~ tr/+/ /; $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; $v =~ s/\t/ /g; $v =~ s/\<.*?\>//gs; $v =~ s/\"//g; $In{$n} = $v; } } # sub ParseFormData sub ErrorHTML { my $s = join("\n

  • ",@_); print "Content-type: text/html\n\n"; print <Error message

    Error message

    • $s
    HTML exit; } # sub ErrorHTML sub StripWhiteSpaceFrontAndBack {my $s=$_[0];$s=~s/\A\s+//;$s=~s/\s+\Z//;return $s;} sub StripAllWhiteSpace {my $s=$_[0];$s=~s/\s+//g;return $s;} sub DiscardExtraSpaces {my $s=$_[0];$s=~s/\A\s+//;$s=~s/\s+\Z//;$s=~s/\s\s+/ /g;return $s;} sub ValidEmail { return 0 if $_[0] =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/; return 0 if $_[0] !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,}|[0-9])(\]?)$/; return 1; } # sub ValidEmail sub ThankYouPage { print "Content-Type: text/html\n\n"; print < Thank You for using our Reciprocal Link Submission Form
    $PublicName

    Thank You for using our
    Reciprocal Link Submission Form

    Your submission will be reviewed and, if approved, added to our Links Page.
    Powered by $TitleTagPublicName
     
    Boogie Jack's Web Depot
    Free HMTL tutorials,
    Graphics, and more!
    		 
    Master Series CGI
    Dozens of Scripts!
    FREE and Commercial

    THANKYOUPAGE exit; } # sub ThankYouPage sub PresentForm { $TA[$ConfigLines{linkfromremotetitle}] = 'Click here' unless $TA[$ConfigLines{linkfromremotetitle}]; print "Content-Type: text/html\n\n"; print < Reciprocal Link Submission Form
    $PublicName

    Reciprocal Link Submission Form

    NOTE: You must already have our link on your web page before using this form. Thank you.

    Here is our link and page title:

    $TA[$ConfigLines{linkfromremoteurl}]
    $TA[$ConfigLines{linkfromremotetitle}]

     
    NOTE:  the [?] help links.

    The complete http://... URL of the page where you have our link: [?]

    The complete http://... URL of the page you want us to link to: [?]

    The Title of the page you want us to link to: [?]

    Your email address: [?]

    (Optional) Your message to our Links Page Maintainer: [?]

    Powered by $TitleTagPublicName
     
    Boogie Jack's Web Depot
    Free HMTL tutorials,
    Graphics, and more!
    		 
    Master Series CGI
    Dozens of Scripts!
    FREE and Commercial

    PRESENTFORMPAGE exit; } # sub PresentForm sub LockFile { my $f = "$_[0]\.lock"; my $tm = time; while((time - $tm) < 12) { last unless open(LOCKFILE,"$f"); my $l = ; close(LOCKFILE); last if index($l,'UNLOCKED') > -1; sleep 2; } open(LOCKFILE,">$f"); print LOCKFILE 'LOCKED'; close(LOCKFILE); } # sub LockFile sub UnLockFile { open(LOCKFILE,">$_[0]\.lock"); print LOCKFILE 'UNLOCKED'; close(LOCKFILE); return 0; } # sub UnLockFile