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;
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.