http://www.perlmonks.org?node_id=958577

silverbullet has asked for the wisdom of the Perl Monks concerning the following question:

I have downloaded a rather simple link creation script. I have done some perl work in the past and decided to follow the format of the script to add a password to keep additions or deletions from happening by those that should not. I cannot get the sub routine to allow passage. It compiles and looks OK to me. I have been looking at it for several days now and no amount of experimentation allows the correct pw to pass. The pw is admin and the code is below. I have added some gtest points and they show that the correct pw has been entered and is being tested against the correct pw to pass. I would like to know what is incorrect in the coding please. What should have been 5 minutes of work has turned into 10 days now and I am no furhter than when I entered the original code. In advance thank you.

#!/usr/bin/perl -w

# The sslinks directory permissions are may need to be set to 755 on s
+ome servers. 
# The sslinks.cgi file should be set to 755 on 'NIX servers. The sslin
+ksdb.txt should be
# set to 766 and the sslinks.css file should be set to 744.

# NOTE! You may have to change the first line in the script from #!usr
+/bin/perl -w
# to the appropriate location of perl on your particular server.



# Sslinks title: Secure Links
# Server installed modules used.
   use CGI::Carp qw(fatalsToBrowser);
   use CGI (param);
   use strict;

# Declare script variables.
   my $pwc = 'admin';
   my $pass = param('pass');
   my @List1 = param('links');
   my $link_name = param('link_name');
   my $link_url = param('link_url');
   my $link_description = param('link_description');
   my $do_add = param('do_add');
   my $do_delete = param('do_delete');
   my $add = param('add');
   my $edit = param('edit');
   my $delete = param('delete');
   my @List2 = ();
   my $db = 'sslinksdb.txt';
   my $entries = `cat $db`;
   my @Links = split('\n\n', $entries);
   my $script = $ENV{'SCRIPT_NAME'};
   my ($Onload);
   my $version = 'Version 1.2';
   my $progname = 'Secure Links';
   my $prognameacro = 'LINKS';
   my $pw1 = '1';
   my $pw2 = '2';
   my $pw3 = '3';
   my $pw4 = '4';
   my $pw5 = '5';

# Get the date.
   my $Date = `/bin/date +"%D"`;
   chomp($Date);
   my ($date) = split(' ',$Date);
   my ($month, $day, $year) = split('/', $date);
   $year = 20 . $year;
   
# Start security login.
&secure;
# must pass before going to main page

# Subroutine selection.
if ($add) { &add_link; }
elsif ($delete) { &delete_links; }
elsif ($do_add) { &link_added; }
elsif ($do_delete) { &links_deleted; }
else { &main_page; }

# Begin html header.
sub header {
   print "Content-type: text/html\n\n";
   print qq~<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Transitional//
+EN">
<html>
<head><title>$prognameacro</title>

<meta http-equiv="Content-Type" content="charset=iso-8859-1">
<meta http-equiv="Content-Style-Type" content="text/css">

<link rel="stylesheet" href="sslinks.css" type="text/css">
</head>
<body>
<div align="center">\n~;
}

# Begin main page.
sub main_page {
   &header;
   print qq~<table class="heading">
<tr><th>$progname</th></tr></table>
<span class="message">$version</span>
<br /><br />\n~;
   &link_count;
   print qq~<br /><br />
<form method="post">
<input class="button" type="submit" name="add" value="Add A Link">
<input class="button" type="submit" name="delete" value="Delete Links"
+>
</form>
<span class="message">(You may need to <a href="javascript:history.go(
+0)">refresh</a> page to see links list changes!)</span>
<br /><br />
<table width="90%" cellpadding="0" cellspacing="0">
<tr><td>
<ul>\n~;

foreach (sort sortem @Links) {
   my ($name, $url, $description, $added) = split('\n');
unless ($description eq 'no description') {
   $description = qq~<span class="description"> \~ [ $description ]</s
+pan>~; }
else {
   $description = ''; }
   print qq~<li> <a href="$url" target="_blank" title="Date Added: $ad
+ded">$name</a>$description</li>\n~; }
   print qq~</td></tr></table>\n~;
   &footer;
}

# Begin add link page.
sub add_link {
   &header;
   print qq~<table class="heading">
<tr><th>Add A New Link
</th></tr></table>
<br /><br /><br />
<form method="post" name="a">
<table>
<tr><td align="right">Link Name:</td>
<td> <input class="textbox" name="link_name"></td><td><span class="not
+ation">This Is Mandatory</span></td></tr>
<tr><td align="right">Link URL:</td>
<td> <input class="textbox" name="link_url" value="http://"></td><td><
+span class="notation">This Is Mandatory</span></td></tr>
<tr><td align="right">Link Description:</td>
<td> <input class="textbox" name="link_description" maxlength="60"></t
+d><td><span class="notation">This Is Optional<br />60 charaters max</
+span></td></tr>
<tr><td colspan="3" align="center" valign="bottom" height="40">
<input class="button" type="submit" name="do_add" value="Add Link">
<input class="button" type="button" value="Cancel" onClick="history.ba
+ck()">
</td></tr></table>
</form>\n~;
   &footer;
}

# Begin link was added page.
sub link_added {
   &error_report;
   my ($description);
if ($link_description) { $description = "$link_description"; }
else { $description = 'no description'; }
   open DB,">>$db" or die "Can't open file!";
   print DB "$link_name\n$link_url\n$description\n$Date\n\n";
   close DB;
   &header;
   print qq~<table class="heading">
<tr><th>Your Link Was Added 
</th></tr></table>
<br /><br />
<table>
<tr><td>\n~;

unless (!$link_description) {
   $description = qq~<span class="description"> \~ [ $description ]</s
+pan>~; }
else {
   $description = ''; }
   print qq~<a href="$link_url" target="_blank" title="Date Added: $Da
+te">$link_name</a>$description<br />
</td></tr></table>
<br /><br /><br />
<form>
<input class="button2" type="button" value="Back To Links Page" onClic
+k="history.go(-2)">
</form>\n~;
   &footer;
}

# Begin delete links page.
sub delete_links {
   &error_report;
   &header;
   print qq~<table class="heading">
<tr><th>Delete One Or More Links
</th></tr></table>
<br /><br />\n~;
   &link_count;
   print qq~<br /><br />
<span class="message">Check As Many Links As You Wish To Delete</span>
<br /><br /><br />
<form method="post">
<table width="90%" cellpadding="0" cellspacing="0">
<tr><td>\n~;

foreach (sort sortem @Links) {
   my ($name, $url, $description, $added) = split('\n');
unless ($description eq 'no description') {
   $description = qq~<span class="description"> \~ [ $description ]</s
+pan>~; }
else {
   $description = ''; }
   print qq~<input type="checkbox" name="links" value="$_">
<a href="$url" target="_blank" title="Date Added: $added">$name</a>$de
+scription<br />\n~; }
   print qq~</td></tr></table>
<br /><br />
<input class="button" type="submit" name="do_delete" value="Delete Lin
+ks">
<input class="button" type="button" value="Cancel" onClick="history.ba
+ck()">
</form>\n~;
   &footer;
}

# Begin links were deleted page.
sub links_deleted {
   &error_report;
if (@List1) {
   my (%cnt, $cnt);
foreach (@Links,@List1) {
   $cnt{$_}++; }
foreach (keys %cnt) {
   push @{ $cnt{$_} != 2 ? \@List2 : next }, $_; }}
   open DB,">$db" or die "Can't open file!";
foreach (sort sortem @List2) {
   print DB "$_\n\n"; }
   close DB;
   &header;
   print qq~<table class="heading">
<tr><th>Selected Links Were Deleted
</th></tr></table>
<br /><br />
<span class="message">Deleted Links Listed Below:</span>
<br />
<table>
<tr><td>\n~;

foreach (@List1) {
   my ($name, $url, $description, $added) = split('\n');
unless ($description eq 'no description') {
   $description = qq~<span class="description"> \~ [ $description ]</s
+pan>~; }
else {
   $description = ''; }
   print qq~<a href="$url" target="_blank" title="Date Added: $added">
+$name</a>$description<br />\n~; }
   print qq~</td></tr></table>
<br /><br /><br />
<form>
<input class="button2" type="button" value="Back To Links Page" onClic
+k="history.go(-2)">
</form>\n~;
   &footer;
}

# Begin the error message page.
sub error_report {
   my ($no_name, $bad_url, $no_links, $no_selected_links, $link_exists
+);
if ($do_add) {
foreach (@Links) {
   my ($name, $url, $description, $added) = split('\n');
if ($link_url =~ /$url/i) { $link_exists = "<br />$name<br />$url"; }}
   $no_name = 1 if ($do_add && !$link_name);
   $bad_url = 1 if ($link_url !~ /^(ftp|http\:\/\/(.)*\.\w+|news\:(.)*
+\.\w+)/i); }
   $no_links = 1 if ($delete && !@Links);
   $no_selected_links = 1 if ($do_delete && !@List1);
if($no_name || $bad_url || $no_links || $no_selected_links || $link_ex
+ists) {
   &header;
   print qq~<table class="heading">
<tr><th>ERROR!
</th></tr></table>
<br /><br /><br />
<table cellpadding="0" cellspacing="0">
<tr><td>
<ul>\n~;

unless ($link_exists) {
if ($no_name) { print qq~<li>You did not enter a link name!</li><br />
+\n~; }}
if ($bad_url) { print qq~<li>The url you entered is either missing or 
+invalid!</li><br />\n~; }
if ($link_exists) { print qq~<li>The link url associated with the name
+ below already exists:$link_exists</li><br />\n~; }
if ($no_links) { print qq~<li>There are no links to delete!</li><br />
+\n~; }
if ($no_selected_links) { print qq~<li>You did not select any links to
+ delete!</li><br />\n~; }
   print qq~</ul>
</td></tr></table>
<br /><br />
<form>
<input class="button" type="button" value="Go Back" onClick="history.b
+ack()">
</form>\n~;
   &footer; }
}

# Begin link count.
sub link_count {
   my ($total, $s);
   $total = 0;
foreach (@Links) { $total++; }
if ($total == 1) { $s = ''; }
else { $s = 's'; }
   print qq~There Are <span class="message">$total</span> Link$s\n~;
}

# Begin case insensitive sort.
sub sortem {
   our ($a,$b);
   lc($a) cmp lc($b);
}

# Begin security.
sub secure {
   &header;
   print qq~<table class="heading">
<tr><th>Security
</th></tr></table>
<br /><br /><br />
<form method="post" name="s">
<table>
<tr><td align="right">Password:</td>
<td> <input class="textbox" name="pass" value=$pass></td><td><span cla
+ss="notation">Please Enter Your Password</span></td></tr>
<tr><td colspan="2" align="center" valign="bottom" height="40">
<input class="button" type="submit" name="checkpw" value="Verify">
</td></tr></table>
</form>\n~;
   &footer;
# Secure inner subroutine
if ($pass eq $pwc) { &main_page; }
else { &sub_secure; }
}

# Begin html footer.
sub footer {
   print qq~<br /><br />
Secure Links pass=$pass pwc=$pwc</div>
<br /><br />
</body>
</html>\n~;
   exit;
}

[download]

Back to Seekers of Perl Wisdom