#!/usr/bin/perl # Author: Kevin P. Inscoe . # File: url_submit.pl # Date of creation: December 14, 2004 # Version: 1.0 # Warranty: None expressed or implied. # License: The Open Software License. V1.1 http://www.opensource.org/licenses/osl.php # # OSI Certified Open Source Software. http://www.opensource.org/licenses/ # # Prerequisites: Perl 5.004 (minimum). require 5.004; # The purpose of this program is # # Receive a POST submit from url_index.pl generated form of a correctly formatted URI to # generate an alternate albeit shorter URL in response while storing the link # in the database along with the submitting address, time and date. Checks are made # to verify the URI is valid (http or https) and shorter than 255 characters. # # Change history: # # 0.9.0 - 12/14/04 - Create original # 1.0.0 - 01/30/05 - Release working version # #Turn off Perl buffering $| = 1; # Pragmas use strict; use diagnostics; use CGI; use Mail::Sendmail; use DBI; use DBD::mysql; use Date::Manip; # Locals my $http_host = $ENV{'HTTP_HOST'}; my $redir = $ENV{'REDIRECT_STATUS'}; my $request_uri = $ENV{'REQUEST_URI'}; my ($query_string); my ($colon, $http, $https) = 0; my $dsn = 'DBI:mysql:xxxxxxxxxx:localhost'; my $db_user_name = 'xxxxxxxxxxxxxx'; my $db_password = 'xxxxxxxxxxxxxxxxx'; # http://lists.evolt.org/archive/Week-of-Mon-20010528/033585.html # http://www.w3.org/Protocols/rfc2616/rfc2616-sec3.html#sec3.2 my $MAXURILEN = 255; # Print the Context-type so output gets dumped to the browser print "Content-type\: text/html\n\n"; # Turn on debugging by changing to a 1. my $debug = 0; # Print all the HTTP ENV variables if ( $debug ) { use CGI::Carp qw(fatalsToBrowser); # Only when debugging foreach my $key (sort(keys(%ENV))) { print "$key = $ENV{$key}
\n"; } } # Get our post value my $request_method = $ENV{'REQUEST_METHOD'}; if ($request_method eq "POST") { read (STDIN, $query_string, $ENV{'CONTENT_LENGTH'}); } else { &disp_error; exit; } &head; my $url = $query_string; $url =~ s/url=//; # Translate the RFC 1738 encoding to HTML friendly format... # New a better way to do this... maybe a subroutine to parse each % field. $url =~ s/%3A/:/g; $url =~ s/%2F/\//g; $url =~ s/%3F/\?/g; $url =~ s/%3D/\=/g; $url =~ s/%26/\&/g; $url =~ s/%2C/\,/g; my $compare = $url; $compare =~ tr/A-Z/a-z/; # Is this URI passed to us valid? $colon = index($compare, ':'); $http = index($compare, 'http://'); $https = index($compare, 'https://'); if (($colon == -1) && ($https == -1) && ($http == -1)) { &bad_url; exit; } # Is this URI passed to us longer than we care to store? my $length = length($url); if ($length > $MAXURILEN ) { &url_too_long; exit; } print "
\n"; print "
\n"; print "

\n"; # Create the tables needed if they don't already exist my $error = &create_tables($dsn,$db_user_name,$db_password); my ($result,$lasturi,$created) = &gen_uri($dsn,$db_user_name,$db_password); my $status = &putdb($result,$url,$dsn,$db_user_name,$db_password,$length); if ( $status) { print "

Your custom URI is

http://url.kevininscoe.com/?$result

\n"; } else { &send_error($status,"putdb"); } # Calculate the age of the last uri my $datediff = &calc_dates($created); print "Last URI issued: $lasturi ($datediff ago)

\n"; &trail; exit; sub head { print "url.kevininscoe.com - Kevin's URI service\n"; print "

Kevin's URI Service

\n"; } sub trail { print "You can also visit: The most visited URL, the longest URL and the shortest URL in our database.

\n"; print "Terms of Service

\n"; print "



\n"; print "Copyright © 2005 Kevin P. Inscoe\n"; print "\n"; $!; } sub disp_error { &head; print "
\n"; print "
\n"; print "

\n"; &trail; } sub gen_uri { # Get our db info passed my ($dsn,$db_user_name,$db_password) = @_; # Get the full date stamp my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time); #Create unique uri key by marrying time stamp (granularity of one second) with PID number my $return = sprintf "%4d%02d%02d%02d%02d%02d\n",$year+1900,$mon+1,$mday,$hour,$min,$sec . $$; # Now lookup database and find the last entry along with it's creation date # Open a connection to the database my $dbha = DBI->connect($dsn, $db_user_name, $db_password) or &send_error("Couldn't connect to database: $DBI::errstr","gen_uri.connect"); my $sql = "SELECT uri,created FROM uri ORDER BY uri DESC LIMIT 1;"; my $statement = $dbha->prepare($sql) or &send_error("Couldn't prepare query '$sql': $DBI::errstr","gen_uri.SELECT"); $statement->execute() or &send_error("Couldn't execute query '$sql': $DBI::errstr","gen_uri.SELECT"); my $result = ""; my $created = ""; while (my $row_ref = $statement->fetchrow_hashref()) { $result = $row_ref->{uri}; $created = $row_ref->{created}; } # Close the handle - must be done after each execute call $statement->finish(); $dbha->disconnect(); return ($return,$result,$created); } sub putdb { my ($uri,$url,$dsn,$db_user_name,$db_password,$length) = @_; # Locals my $refer = $ENV{'HTTP_REFERER'}; my $browser = $ENV{'HTTP_USER_AGENT'}; my $ip = $ENV{'REMOTE_ADDR'}; my $dbhb = DBI->connect($dsn, $db_user_name, $db_password) or &send_error("Couldn't connect to database: $DBI::errstr","putdb"); # Get rid of newline in the uri chomp($uri); # Creation time for this record # Get the full date stamp and then a unique 5 digit seq. num after that my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time); # Create the time stamp (granularity of one second) my $created = sprintf "%4d%02d%02d%02d%02d%02d\n",$year+1900,$mon+1,$mday,$hour,$min,$sec; chomp($created); # Now create the record in the database my $sql = "INSERT INTO uri (uri,url,ip,browser,referer,length,created) VALUES ('$uri','$url','$ip','$browser','$refer','$length','$created');"; my $statement = $dbhb->prepare($sql) or &send_error("Couldn't prepare query '$sql': $DBI::errstr","putdb.INSERT"); $statement->execute() or &send_error("Couldn't execute query '$sql': $DBI::errstr","putdb.INSERT"); # Close the handle - must be done after each execute call $statement->finish(); $dbhb->disconnect(); return -1; } sub send_error { my ($error, $routine)=@_; print "

An internal error has occured. The Web administrator has been notified.
\n"; print "Please try again. If the error persists please try again later.
\n"; print "
Sorry for the inconvenience.

\n"; &trail; my %mail = ( To => 'admin@kevininscoe.com', From => 'admin@kevininscoe.com', Subject => 'Error from url.kevininscoe.com', Message => "Error from url.kevininscoe.com/submit.cgi in routine $routine:\n\n$error\n\n" ); sendmail(%mail) or die $Mail::Sendmail::error; exit 1; } sub create_tables { my ($dsn,$db_user_name,$db_password) = @_; my ($dbhc,$dbhd,$dbhe,$dbhf,$dbhg,$dbhh,$dbhi,$sql,$statement,$result); # Open a connection to the database $dbhc = DBI->connect($dsn, $db_user_name, $db_password) or &send_error("Couldn't connect to database: $DBI::errstr","create_tables.connect"); # Determine if the "uri" table exists first $sql = "SELECT * FROM uri;"; $statement = $dbhc->prepare($sql) or &send_error("Couldn't prepare query '$sql': $DBI::errstr","create_tables.SELECT"); $result = $statement->execute(); # Close the handle - must be done after each execute call $statement->finish(); $dbhc->disconnect(); if ($result eq '') { # Setup our SQL to create and populate our tables if they do not already exist $sql = "CREATE TABLE uri (" . "uri VARCHAR(20) NOT NULL," . "url VARCHAR(255) NOT NULL," . "ip VARCHAR(16)," . "browser VARCHAR(250)," . "visits INT DEFAULT '0' NOT NULL," . "rank FLOAT DEFAULT '0.0'," . "length INT DEFAULT '0' NOT NULL," . "created VARCHAR(20) NOT NULL," . "last_visit TIMESTAMP(16) NOT NULL," . "repeats INT DEFAULT '0' NOT NULL," . "referer VARCHAR(255)," . "KEY xuri (uri)," . "KEY xurl (url)," . "PRIMARY KEY (uri)" . ");"; # Open a connection to the database $dbhd = DBI->connect($dsn, $db_user_name, $db_password) or &send_error("Couldn't connect to database: $DBI::errstr","create_tables.connect"); $statement = $dbhd->prepare($sql) or &send_error("Couldn't prepare query '$sql': $DBI::errstr","create_tables.CREATE"); $statement->execute() or &send_error("Couldn't execute query '$sql': $DBI::errstr","create_tables.CREATE"); # Close the handle - must be done after each execute call $statement->finish(); $dbhd->disconnect(); } # Determine if the "hits" table exists first $sql = "SELECT * FROM hits;"; # Open a connection to the database $dbhe = DBI->connect($dsn, $db_user_name, $db_password) or &send_error("Couldn't connect to database: $DBI::errstr","create_tables.connect"); $statement = $dbhe->prepare($sql) or &send_error("Couldn't prepare query '$sql': $DBI::errstr","create_tables.SELECT"); $result = $statement->execute(); # Close the handle - must be done after each execute call $statement->finish(); $dbhe->disconnect(); if ($result eq '') { # Setup our SQL to create and populate our tables if they do not already exist $sql = "CREATE TABLE hits (" . "uri VARCHAR(20) NOT NULL," . "ip VARCHAR(16)," . "browser VARCHAR(250)," . "time TIMESTAMP(16) NOT NULL," . "referer VARCHAR(255)," . "KEY xuri (uri)" . # "PRIMARY KEY (uri)" . ");"; # Open a connection to the database $dbhf = DBI->connect($dsn, $db_user_name, $db_password) or &send_error("Couldn't connect to database: $DBI::errstr","create_tables.connect"); $statement = $dbhf->prepare($sql) or &send_error("Couldn't prepare query '$sql': $DBI::errstr","create_tables.CREATE"); $statement->execute() or &send_error("Couldn't execute query '$sql': $DBI::errstr","create_tables.CREATE"); # Close the handle - must be done after each execute call $statement->finish(); $dbhf->disconnect(); } # Determine if the "create" table exists first $sql = "SELECT * FROM created;"; # Open a connection to the database $dbhg = DBI->connect($dsn, $db_user_name, $db_password) or &send_error("Couldn't connect to database: $DBI::errstr","create_tables.connect"); $statement = $dbhg->prepare($sql) or &send_error("Couldn't prepare query '$sql': $DBI::errstr","create_tables.SELECT"); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time); my $date = sprintf "%4d-%02d-%02d",$year+1900,$mon+1,$mday; $result = $statement->execute(); # Close the handle - must be done after each execute call $statement->finish(); $dbhg->disconnect(); if ($result eq '') { # Setup our SQL to create and populate our tables if they do not already exist $sql = "CREATE TABLE created (" . "created TIMESTAMP(16) NOT NULL," . "dummy INT DEFAULT '0' NOT NULL," . "KEY xcreated (created)," . "PRIMARY KEY (created)" . ");"; # Open a connection to the database $dbhh = DBI->connect($dsn, $db_user_name, $db_password) or &send_error("Couldn't connect to database: $DBI::errstr","create_tables.connect"); $statement = $dbhh->prepare($sql) or &send_error("Couldn't prepare query '$sql': $DBI::errstr","create_tables.CREATE"); $statement->execute() or &send_error("Couldn't execute query '$sql': $DBI::errstr","create_tables.CREATE"); # Close the handle - must be done after each execute call $statement->finish(); $dbhh->disconnect(); # Now update the creation timestamp by inserting a dummy value into the dummy field. $sql = "INSERT INTO created (dummy) VALUES (1);"; # Open a connection to the database $dbhi = DBI->connect($dsn, $db_user_name, $db_password) or &send_error("Couldn't connect to database: $DBI::errstr","create_tables.connect"); $statement = $dbhi->prepare($sql) or &send_error("Couldn't prepare query '$sql': $DBI::errstr","create_tables.INSERT"); $statement->execute() or &send_error("Couldn't execute query '$sql': $DBI::errstr","create_tables.INSERT"); # Close the handle - must be done after each execute call $statement->finish(); $dbhi->disconnect(); } return -1; } sub bad_url { print "\n"; print "
\n"; print "

\n"; print "

Unsupported scheme. Only http and https supported.
\n"; print "Please try again.

\n"; &trail; } sub url_too_long { print "\n"; print "
\n"; print "

\n"; print "

URL too long! URL's are only supported to a maximum length of $MAXURILEN.
\n"; print "

Please consult RFC 2626.
\n"; print "

Please try again.

\n"; &trail; } sub calc_dates { my ($created) = @_; # Locals my ($datediff,$cyear,$cmonth,$cday,$cdays,$chour,$cmin,$now,$days); # Get the full date stamp my ($sec,$min,$hour,$mday,$mon,$yr,$wday,$yday,$isdst)=localtime(time); my $year = sprintf "%4d",$yr+1900; my $month = sprintf "%02d",$mon+1; # Convert the created time into epoch time $cyear = substr($created,0,4); $cmonth = substr($created,4,2); $cday = substr($created,6,2); $chour = substr($created,8,2); $cmin = substr($created,10,2); # If less than a day difference have to use the time fields # http://search.cpan.org/~sbeck/DateManip-5.40/Manip.pod my $ctime = &ParseDate("$cmonth/$cday/$cyear $chour:$cmin"); my $ntime = &ParseDate("$month/$mday/$year $hour:$min"); my $delta = &DateCalc($ntime,$ctime); # => 0:0:WK:DD:HH:MM:SS the weeks, days, hours, minutes, and seconds between the two my ($dummy1, $dummy2,$dwks,$ddays,$dhours,$dmins,$dsecs) = split (/:/,$delta); # Decide how to format it $datediff = ""; if ($ddays > 0) { $datediff = "$ddays day(s)"; } else { if ($dhours > 0) { $datediff = "$dhours hour(s)" } else { $datediff = "$dmins minute(s)" } } return ($datediff); }