#!/usr/bin/perl -w
# The sslinks directory permissions are may need to be set to 755 on some servers.
# The sslinks.cgi file should be set to 755 on 'NIX servers. The sslinksdb.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.
use strict;
# Sslinks title: Secure Links
# Server installed modules used.
use CGI::Carp qw(fatalsToBrowser);
use CGI;
my $q = CGI->new;
my $cookie;
#use CGI (param);
# change param() to $q->param()
# Declare script variables.
my $pwc = 'admin';
my $pass = $q->param('pass');
my @List1 = $q->param('links');
my $link_name = $q->param('link_name');
my $link_url = $q->param('link_url');
my $link_description = $q->param('link_description');
my $do_add = $q->param('do_add');
my $do_delete = $q->param('do_delete');
my $add = $q->param('add');
my $edit = $q->param('edit');
my $delete = $q->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;
if (not &check_secure) { &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; }
# THIS IS FOR EXAMPLE ONLY - NOT SECURE
sub check_secure {
if ( $q->cookie('auth') ) {
return 1;
}
elsif ($pass eq $pwc) {
$cookie = $q->cookie(-name=>'auth', -value=>"xyx");
return 1;
}
else { return; }
}
# Begin html header.
sub header {
if ($cookie) {
print $q->header(
-type => 'text/html',
-expires => '+1d',
-cookie => [$cookie]
);
}
else {
print $q->header(
-type => 'text/html',
);
}
#print "Content-type: text/html\n\n"; # NO NEED FOR THIS
print qq~
\n~;
}
# Begin main page.
sub main_page {
&header;
print qq~
$version
\n~;
&link_count;
print qq~
(You may need to refresh page to see links list changes!)
\n~;
foreach (sort sortem @Links) {
my ($name, $url, $description, $added) = split('\n');
unless ($description eq 'no description') {
$description = qq~ \~ [ $description ]~; }
else {
$description = ''; }
print qq~- $name$description
\n~; }
print qq~ |
\n~;
&footer;
}
# Begin add link page.
sub add_link {
&header;
print qq~
\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~
\n~;
unless (!$link_description) {
$description = qq~ \~ [ $description ]~; }
else {
$description = ''; }
print qq~$link_name$description
|
\n~;
&footer;
}
# Begin delete links page.
sub delete_links {
&error_report;
&header;
print qq~
\n~;
&link_count;
print qq~
Check As Many Links As You Wish To Delete
\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~
Selected Links Were Deleted
|
---|
Deleted Links Listed Below:
\n~;
foreach (@List1) {
my ($name, $url, $description, $added) = split('\n');
unless ($description eq 'no description') {
$description = qq~ \~ [ $description ]~; }
else {
$description = ''; }
print qq~$name$description \n~; }
print qq~ |
\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 = "
$name
$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_exists) {
&header;
print qq~
\n~;
unless ($link_exists) {
if ($no_name) { print qq~- You did not enter a link name!
\n~; }}
if ($bad_url) { print qq~- The url you entered is either missing or invalid!
\n~; }
if ($link_exists) { print qq~- The link url associated with the name below already exists:$link_exists
\n~; }
if ($no_links) { print qq~- There are no links to delete!
\n~; }
if ($no_selected_links) { print qq~- You did not select any links to delete!
\n~; }
print qq~
|
\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
$total Link$s\n~;
}
# Begin case insensitive sort.
sub sortem {
our ($a,$b);
lc($a) cmp lc($b);
}
# Begin security.
sub secure {
&header;
print qq~
\n~;
&footer;
# Secure inner subroutine
# if ($pass eq $pwc) { &main_page; }
# else { &sub_secure; }
}
# Begin html footer.
sub footer {
print qq~
Secure Links pass=$pass pwc=$pwc