Another simple script I’ve written and use often (actually runs via cron every 5 minutes) to verify the contents of a particular page to determine of it has changed for any reason like a webserver cracked/hacked or if the dynamic content is not what is expected.

In this case it is specifically monitoring a page from a PeopleSoft application that I do not entirely trust, if the content doesn’t match my checksum that generally means the Tuxedo application server is hosed and needs to be restarted.

Easily adapted to fit your particular needs, is use it on all of my public websites that are on shared hosting accounts etc…

Comments for bigger sections are thrown in to give you an idea of what to tweak for your needs, remember to update $file2 with a new copy of the markup if you modify the landing page you are monitoring!

[code]
#!/pshome/usr/local/bin/perl

# This just checks what the current working directory is,
# if dev or test then set the debug flags to on...etc.
unshift(@INC, "/pshome/psmgr/bin");
unshift(@INC, "/pshome/psmgr/bin.test") if ("/pshome/psmgr/bin.test" eq "$ENV{'PWD'}");
unshift(@INC, "/pshome/psmgr/stat/bin") if ("/pshome/psmgr/stat/bin" eq "$ENV{'PWD'}");
require sr;

$debug = 1;
$debug = 1 if ("/home/bin.test" eq "$ENV{'PWD'}");
$debug = 1 if ("/home/stat/bin" eq "$ENV{'PWD'}");
$execute = 1;

$file1 = "/home/files/sitename.tmp";
$file2 = "/home/files/sitename_known_good.txt";
$url = "https://yoursite.com/psc/hrmsext/EMPLOYEE/HRMS/c/ROLE_APPLICANT.ER_APPLICANT_HOME.GBL?&";
$url = "https://yoursite.com/psc/test/EMPLOYEE/HRMS/c/ROLE_APPLICANT.ER_APPLICANT_HOME.GBL" if ("/pshome/psmgr/bin.test" eq "$ENV{'PWD'}");
$url = "https://yourseite.com/psc/test/EMPLOYEE/HRMS/c/ROLE_APPLICANT.ER_APPLICANT_HOME.GBL" if ("/pshome/psmgr/stat/bin" eq "$ENV{'PWD'}");
$restarting = "/pshome/psmgr/files/careers.restarting";
$restartingold = "/pshome/psmgr/files/careers.restarting.old";
$check = "0";

# check to see if the restart is already in progress so we don't interrupt it
# likely a cleaner way to do this, but it works for now!
if (-e $restarting) { # check if restart file exists
print "Restart file exists, servers may be restarting, check again in 5 mins\n";
print "Renaming file and Exiting\n";
$cmd = "mv $restarting $restartingold";
print "$cmd\n" if ($debug);
system ($cmd) if ($execute);
exit;
} #end if restart file exists

if (-e $restartingold) { # check if restarting.old file still exists
print "Restarting file existed for at least 5 mins, servers should be back up, rechecking";
print "Remove restart file\n";
$check = "1";
$cmd = "rm $restartingold";
print "$cmd\n" if ($debug);
system ($cmd) if ($execute);
} #end if restarting.1 file exists

$cmd = "wget -b --no-check-certificate --output-document=$file1 $url";
print "$cmd\n" if ($debug);
system ($cmd) if ($execute);

$cmd = "sleep 15";
print "$cmd - sleeping 15 secs to allow complete xfer of file\n" if ($debug);
system ($cmd) if ($execute);

$diff1=`cksum $file1`;
$diff2=`cksum $file2`;
$diff1value = substr($diff1, 0, 9);
$diff2value = substr($diff2, 0, 9);

print "diff1value = $diff1value\n" if ($debug);
print "diff2value = $diff2value\n" if ($debug);

if ($diff1value != $diff2value) {
&notifydown;
&repair;
&cleanup;
exit;
} else {
print "Files match, this site is up!\n";
&cleanup;
print "check = $check\n" if ($debug);
if ($check == "1") { #check if recovering from restart
¬ifyup;
} # end check if recovered from restart
exit;
}

sub notifydown
{
print "This site appears to be down, sending page and email\n" if ($debug);
&sr::send_email($debug,"Site Down!","Site is down, restarting app servers now!","David Cochran");
&sr::send_page($debug,"Careers site is down, restarting app servers now!","David Cochran");
} # end sub notifydown

sub repair
{ # restart HRMSEXT App servers
$cmd = "mv $file1 $restarting";
print "$cmd\n" if ($debug);
system ($cmd) if ($execute);
$cmd = "/commands to restart the application server go here";
print "$cmd\n" if ($debug);
system ($cmd) if ($execute);
} #end sub repair

sub cleanup
{ # cleanup temp files
$cmd = "rm -f wget-log*";
print "$cmd\n" if ($debug);
system ($cmd) if ($execute);
$cmd = "rm -f $file1";
print "$cmd\n" if ($debug);
system ($cmd) if ($execute);
} #end sub cleanup

sub notifyup
{
print "site is back up, sending page and email.\n" if ($debug);
&sr::send_email($debug,"site is OK!","Careers site is OK.","David Cochran");
&sr::send_page($debug,"Careers site is back up","David Cochran");
} # end sub notifyup
[/code]

Managing a lot of SSL certificates? Hate being surprised when they expire on you and break your web site? How about a simple process to notify you in advance?

All of the above sound about right? It does to me, I literally manage close to 100 web sites that require SSL encryption for sensitive data transfers, it seems almost impossible to get and keep them all lined up for expiration dates. Even when they were something new would come along and mess up the rotation, in short order it looks like a shotgun blast to a calendar was the deciding factor.

Here is an easy perl script I wrote to check the dates of existing SSL certs, it gets the URL list to check from certs.urls, compares the certificate expiration date to the current date and send emails at the specified intervals. Pretty simple, but like most, it’s very effective when run daily via cron.

I’ve edited some of the partially confidential stuff out, but not enough to render the script unusable by any means, just set the email.sr to your local email faciltiy.

[code]
#! /usr/local/bin/perl
#
# check_ssl_expire.pl, v 0.01
#
# Inital version - Dave Cochran 9/13/07
###########################################################
use Switch;
use Time::Local;

unshift(@INC, "/pshome/psmgr/bin");
unshift(@INC, "/pshome/psmgr/bin.test") if ("/pshome/psmgr/bin.test" eq "$ENV{'PWD'}");
unshift(@INC, "/pshome/psmgr/stat/bin") if ("/pshome/psmgr/stat/bin" eq "$ENV{'PWD'}");
require sr;

$debug = 0;
$debug = 1 if ("/pshome/psmgr/bin.test" eq "$ENV{'PWD'}");
$debug = 1 if ("/pshome/psmgr/stat/bin" eq "$ENV{'PWD'}");
$execute = 1;

$path = "/pshome/tmp";
@urls = `cat /pshome/psmgr/files/cert.urls`;

foreach $url (@urls) { # start for each url
chomp $url;
print "\nChecking $url\n";
$cmd = "echo \"\" | openssl s_client -connect $url:443 > $path/certificate";
print "\n\n $cmd\n\n" if ($debug);
system ($cmd) if ($execute);

$cmd = "openssl x509 -in $path/certificate -noout -enddate > $path/outdate";
print " $cmd\n\n" if ($debug);
system ($cmd) > $result if ($execute);

open (OUTDATE, "/pshome/tmp/outdate") || die "couldn't open the file!";
$enddate = ;
chomp $enddate;
close(OUTDATE);
print "SSL enddate is: < $enddate>\n" if ($debug);
$expire = substr($enddate, 9, 20);
print "Expire date : < $expire>\n" if ($debug);
$month = substr($expire, 0, 3);
$day = substr($expire, 4, 2);
$year = substr($expire, 16, 4);

switch ("$month")
{
case "Jan" { $month = 0 }
case "Feb" { $month = 1 }
case "Mar" { $month = 2 }
case "Apr" { $month = 3 }
case "May" { $month = 4 }
case "Jun" { $month = 5 }
case "Jul" { $month = 6 }
case "Aug" { $month = 7 }
case "Sep" { $month = 8 }
case "Oct" { $month = 9 }
case "Nov" { $month = 10 }
case "Dec" { $month = 11 }
else { print "$month is not a valid month. You have problems!\n" }
} # end switch on month
$day =~ s/ /0/;
$expire_date = timegm(1,0,0,$day,$month,$year - 1900);
$today = `date +%Y%m%d`;
chomp $today;
$today = timegm(1,0,0,`date +%d`,`date +%m` -1,`date +%Y` - 1900);
$thirty_days = $today + (86400 * 30);
$fifteen_days = $today + (86400 * 15);
$seven_days = $today + (86400 * 7);
$one_day = ($today + 86400);

print "Today is < $today> and the cert expires on < $expire_date>\n" if ($debug);
print "1 day is < $one_day>\n" if ($debug);
print "7 days is < $seven_days>\n" if ($debug);
print "15 days is < $fifteen_days>\n" if ($debug);
print "30 days is < $thirty_days>\n" if ($debug);

$subject = "$url certificate expiration";
if ($today > $expire_date) { # start if the certificate is expired
&sr::send_page($debug,"$url cert expired",'Paul Hofmann','David Cochran');
$message = "The $url certificate is expired";
print "\t$message\n";
&sr::send_email($debug,$subject,$message,'David Cochran');
} # end if the certificate is expired
elsif ($one_day == $expire_date) { # start else if the certificate will expire in 1 day
&sr::send_page($debug,"$url cert expires in 1 day",'David Cochran');
$message = "The $url certificate will expire in 1 day";
print "\t$message\n";
&sr::send_email($debug,$subject,$message,'David Cochran');
} # end if the certificate will expire in 1 day
elsif ($seven_days == $expire_date) { # start else if the certificate will expire in 7 days
$message = "The $url certificate will expire in 7 days";
print "\t$message\n";
&sr::send_email($debug,$subject,$message,'David Cochran');
} # end if the certificate will expire in 7 days
elsif ($fifteen_days == $expire_date) { # start else if the certificate will expire in 15 days
$message = "The $url certificate will expire in 15 days";
print "\t$message\n";
&sr::send_email($debug,$subject,$message,'David Cochran');
} # end if the certificate will expire in 15 days
elsif ($thirty_days == $expire_date) { # start else if the certificate will expire in 30 days
$message = "The $url certificate will expire in 30 days";
print "\t$message\n";
&sr::send_email($debug,$subject,$message,'David Cochran');
} # end if the certificate will expire in 30 days
} # end for each url

[/code]

URLs are stored in cert.urls with no http:// prefix

[code]
blog.captivereefing.com
www.captivereefing.com
[/code]

You get the idea…

Happy hacking!

Like all programing languages, there are many ways to connect to databases, this in particular shows a the simplest method, though burying the host, username and password in an include would be better for security reasons, this is effective enough for most purposes.

The only requirements for perl may be the DBD::mysql module if not already installed, this should get all the needed prerequisites that may not be present. Either download them directly from CPAN or use the interactive installer shell

[code]
$perl -MCPAN -e shell
$install DBD::mysql
[/code]

To use this example copy this code into your script, edits $username, $password, and $db_name values to suit your environment.

[code]
#Invoke the Perl Database Libraries
use DBI;

# MySQL server hostname
my $host = "mysql.serverhost.com";

#your account username and MySQL password
my $username = "your_user";
my $password = "your_MySQL_password";

#Edit this to point to the database you wish to connect to
my $db_name = "your_database";

#
#The following lines do not need to be edited
#
#put the database and server in to the connect statement
$dsn = "DBI:mysql:database=$db_name;host=$host";

#Generate the full connect statement
$dbh = DBI->connect($dsn, $username, $password);

#run the connect statement
$self->dbh = $dbh;
[/code]

After a recent incident of some piss poor script kiddie defacing one of of my websites I wote a quick and dirty little perl script to both monitor and repair things should it happen again. (thus giving me much more narrow window of server logs to check to find the exploit or whatever allowed it to happen in the first place).

Here’s how it works in a nutshell, the site’s content is completely dynamic, however the php script to generate it is static..

Pretty simple, and I’m certain my code could be optimized to run a lot cleaner (if you want to submit a cleaner version by all means post it in the comments!) In the interim this works.

compare.pl
[code]
#!/usr/bin/perl
###Dave Cochran http://www.greyfuzz.com
$file1 = "index.php";
$file2 = "index.good";
$diff1=`cksum $file1`;
$diff2=`cksum $file2`;
$diff1value = substr($diff1, 0, 9);
$diff2value = substr($diff2, 0, 9);
if ($diff1value != $diff2value)
{
&page;
&repair;
exit;
}
#print "no difference in file checksums.";
#uncomment the line above for testing
exit;

sub page
{
# sendmail routine source from http://kangry.com/topics/viewcomment.php?index=427
use Time::localtime;
open (OUT,"|/usr/sbin/sendmail -t");
print OUT "From: you\@yourdomain.com\n";
#remember to escape the @
print(OUT "Date: ".ctime()."\n");
print(OUT "To: email\@youremailorpager.com\n");
#remember to escape the @
print(OUT "Subject: Index.php changed!\n");
print(OUT "\n");
print(OUT "index.php has been changed!\n");
close(OUT);
} # end sub page

sub repair
{
use Time::localtime;
use File::Copy;
rename($file1, $file1.ctime()) || die "Cannot rename file.txt: $!";
copy($file2, $file1) or die "File cannot be copied.";
} # end sub repair
[/code]

This will require two perl modules Time::localtime and File::Copy which are generally installed with the perl bundle by default, if not get them from CPAN or contact your host.

Simply run the script I called compare.pl via cron or whatever means you wish as often as you want to check the page. Personally every 5 mins works out pretty good for me.

Feel free to use the code above as you will, modify it to suit your needs, be it to protect your web pages, files, or whatever. If you find it useful, please send $$$, or just a thanks.

File Manipulation

• Perl provides a large number of functions to perform various operations on files
• These are very similar to the corresponding UNIX system call or command
• See the UNIX man pages for details

File Test Operators

• Operates on a filename or filehandle argument (except for -t which only operates on a filehandle argument)
• Tests associated file to determine if something is true or not about the file
• If the argument is omitted, $_ is tested (except for -t which tests STDIN)
• Most of these operators return 1 for True and the empty string for False, or undef if the file does not exist (except for -s which returns the file size and -M, -A and -C which return the
  file age)
• Precedence is higher than logical and relational operators, but lower than arithmetic operators
• For superuser, -r, -R, -w and -W always return True and -x and -X return True if ANY execute bit is set

Example;

[code]
if (-e "/etc/passwd") # Does it exist?
{
print ("Let's start hacking!\n");
}
[/code]

File Test Operator List

• -r File is readable by effective uid
• -w File is writable by effective uid
• -x File is executable by effective uid
• -o File is owned by effective uid
• -R File is readable by real uid
• -W File is writable by real uid
• -X File is executable by real uid
• -O File is owned by real uid
• -e File exists
• -z File exists and has zero size
• -s File exists and has nonzero size (returns size in bytes)
• -f File is a plain file
• -d File is a directory
• -l File is a symbolic link
• -p File is a named pipe (FIFO)
• -S File is a socket
• -b File is a block special file
• -c File is a character special file
• -u File has its setuid bit set
• -g File has its setgid bit set
• -k File has its sticky bit set
• -t Filehandle is a tty
• -T File is a text file
• -B File is a binary file
• -M Modification age in days
• -A Access age in days
• -C Inode-modification age in days

Stat Function

• stat FILEHANDLE
• stat (FILENAME)

Useful for file info which the file test operators do not provide (such as number of links) or for finding the true mode when superuser

– Typical use:

($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat ($filename);

$file = “toy1.c”;
($uid, $gid) = stat ($file) [4,5];

Lstat Function

• Same as the stat() function, but gives info on a symbolic link itself
• lstat (FILEHANDLE)

• lstat FILEHANDLE
• lstat (FILENAME)

ul>

The _ Filehandle

• Whenever a file test operator, stat function or lstat function is used, Perl invokes the proper system call (stat(2) on UNIX) to get the required info
• Doing a file test, stat or lstat on the special _ filehandle, causes Perl to use the existing memory cache (stat buffer) of file info from the previous file test, stat or lstat

-Example

[code]
if (-r $file && -w _)
{
print ("$file is both readable and writable\n");
}
[/code]

The above does only one invocation of stat(2) which is more efficient than the following which causes two invocations of stat(2):

[code]
if (-r $file && -w $file)
{
print ("$file is both readable and writable\n");
}
[/code]

File Name Expansion (Globbing)

• If the string inside angle brackets is NOT a filehandle, it is interpreted as a C-Shell Filename Expansion (Globbing) pattern (versus the input operator)
• All C-Shell globbing metacharacters are valid: *, ?, [], -, {}, ~
• In an array context, the glob returns a list of all filenames that match (or an empty list if none match). In a scalar context, the next filename that matches is returned (or undef if there are no more matches). This is all similar to how the input operator with a filehandle works.
• One level of scalar variable interpolation is done
• But since < $x> indicates an indirect filehandle, use < ${x}> for globbing

-Example

[code]
< *.c> # All files that end in c
# Files ch1, ch2 and ch3

$x = "*.c";
< ${x}> # All files that end in c
[/code]

Unlink Function

• Removes one or more files (actually deletes links)
• unlink (LIST)
• unlink LIST
• Returns the number of files successfully deleted
• On failure $! is set to the value of errno
• Uses unlink(2)

Typical use:

[code]
$count = unlink ("toy1.c", "toy2.c", "toy3.c");

$count = unlink (< *.c>);
[/code]

-Example

[code]
#!/usr/bin/perl
# Simple rm program

foreach $file (@ARGV)
{
unlink ($file) || print ("Could not unlink $file: $!\n");
}
[/code]

Rename Function

• Renames a file
• rename (OLDNAME, NEWNAME)
• Returns 1 for success, 0 for failure
• On failure $! is set to the value of errno
• Similar to mv(1), but does NOT rename across filesystems and does not work if OLDNAME is a regular file and NEWNAME is an existing directory

– Typical use:
[code]
$status = rename ("toy1.c", "toy2.c");
$status = rename ("toy1.c", "toys/toy1.c");
[/code]

Link Function

• Creates a new hard link for a file
• link (OLDNAME, NEWNAME)
• Returns 1 for success, 0 for failure
• On failure $! is set to the value of errno
• Uses link(2)

– Typical use:

[code]
$status = link ("toy1.c", "toy2.c");
[/code]

Symlink Function

• Creates a new symbolic (soft) link for a file
• symlink (OLDNAME, NEWNAME)
• Returns 1 for success, 0 for failure
• On failure $! is set to the value of errno
• Uses symlink(2)

– Typical use:
[code]
$status = symlink ("toy1.c", "toy2.c");
[/code]

Readlink Function

• Reads the contents of a symbolic link file
• readlink (FILENAME)
• readlink FILENAME
• Returns link contents on success, undef on failure
• On failure $! is set to the value of errno
• Uses readlink(2)
• Uses $_ if FILENAME is omitted

– Typical use:
[code]
$link = readlink ("toy2.c");
[/code]

Chmod Function

• Changes the mode (permissions) of a list of files
• chmod (LIST)
• chmod LIST
• Returns the number of files successfully changed
• On failure $! is set to the value of errno
• Uses chmod(2)
• The first element of the list must be the numerical mode

– Typical use:
[code]
$count = chmod (0755, "toy1.c");
[/code]

Chown Function

• Changes the owner and group of a list of files
• chown (LIST)
• chown LIST
• Returns the number of files successfully changed
• On failure $! is set to the value of errno
• Uses chown(2)
• The first two elements of the list must be the numerical uid and gid

– Typical use:
[code]
$count = chown ($uid, $gid, );
[/code]

Utime Function

• Changes the access (atime) and modification (mtime) times of a list of files
• utime (LIST)
• utime LIST
• Returns the number of files successfully changed
• On failure $! is set to the value of errno
• Similar to touch(1)
• The first two elements of the list must be the numerical access and modification times
• The inode modification time (ctime) is set to the current time

– Typical use:
[code]
$count = utime ($atime, $mtime, "toy1.c");
[/code]

Borrowed and reformatted from http://umbc7.umbc.edu/~tarr/perl/perl4/ch12-filemanip.html so I wouldn’t loose it.