$prognameacro

sub secure { if ($pass eq $pwc) { return &main_page; } &header; print qq~ etc. ##

##

#use CGI (param); # CHANGE THIS TO...
use CGI;
my $q = CGI->new;
my $cookie; # ADD THIS

# CHANGE ALL param() TO $q->param()
# ...
my $pass = $q->param('pass');
# ...

# Start security login.
#&secure; # CHANGE THIS TO...
if (not &check_secure) { &secure; }
# must pass before going to main page

# Subroutine selection.
if ($add) { &add_link; }
#....

# THIS IS FOR EXAMPLE ONLY - NOT SECURE

sub check_secure {
	if ( $q->cookie('auth') eq 'some_secure_value') {
		return 1;
	}
	elsif ($pass eq $pwc) {
		$cookie = $q->cookie(
			-name=>'auth',
			-value=>"some_secure_value"
		);
		return 1;
	}
	else { return 0; }
}

# NEED TO CHANGE header() FUNCTION TO SET COOKIE

# 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 NOW
	print qq~
	...
	etc~;
}

##

##

#!/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~

$prognameacro







\n~;
}

# Begin main page.
sub main_page {
   &header;
   print qq~

$progname


$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~
Add A New Link







Link Name:
 This Is Mandatory
Link URL:
 This Is Mandatory
Link Description:
 This Is Optional
60 charaters max




\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~
Your Link Was Added 





\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~
Delete One Or More Links



\n~;
   &link_count;
   print qq~


Check As Many Links As You Wish To Delete






\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 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~
ERROR!







\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~
Security







Password:
 Please Enter Your Password



\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




\n~;
   exit;
}

Link Name:		This Is Mandatory
Link URL:		This Is Mandatory
Link Description:		This Is Optional 60 charaters max