#!/usr/local/bin/perl
# dateable.cgi script by David Efflandt - tech@de-srv.com
# This script is copyright 1999
# Displays a remote web page.
# Last updated 9/12/99
#
# TERMS AND CONDITIONS:
# ----------------------
# Usage of this script and participation in the Daily Love Quotes program is subject to compliance
# with the Terms and conditions set forth below. Your usage of this script and participation in this
# program is an acknowledgement that you have read this agreement, and that you agree to be bound by
# the terms and conditions below. If you do not agree to these terms and conditions, you may not use
# this script nor participate in the Daily Love Quote Program. You agree to indemnify, defend, and
# hold harmless Jennifer Klein, Dateable.com LLC and all employees and associates from any and all
# liability, penalties, losses, damages, costs, expenses, attorneys' fees, causes of action or claims
# caused by or resulting indirectly from your use of this script which damages either you, or any other
# party or parties without limitation or exception. This indemnification and hold harmless agreement
# extends to all issues associated with this script, including but not limited to security, and fitness
# for a particular purpose.
#
# This service is provided on an "as is" basis without warranties of any kind, either express or implied,
# including but not limited to warranties of title, no infringement, or implied warranties of
# merchantability or fitness for a particular purpose. No advice or information given by Dateable.com,
# or any employee or member of Dateable.com shall create a warranty.
#
# Selling the code for this program without prior written consent is expressly forbidden, as is charging
# for the installation and/or usage of it. This script may not be redistributed this over the Internet
# or in any other medium.
$url = 'http://dateable.com/quote.shtml';
$nph = 0;
require 5.002;
use Socket;
$reply = &getpage($url);
while ($reply[0] =~ /30(1|2)/) {
foreach $line (@reply) {
if ($line =~ /HREF="([^\"]+)"/i) {
$url = $1;
$reply = &getpage($url);
last;
}
}
}
unless ($nph) {
while ($_ = shift @reply) {
$content = "$_\n" if lc($_) =~ /^content-type:/;
last unless /\S+/;
}
unshift @reply, $content;
}
$" = '';
$reply = "@reply";
$reply =~ s|()|$1|i
unless lc($reply) =~ //m;
print $reply;
exit;
sub getpage {
my ($type, $uri, $remote, $port, $iaddr, $paddr, $proto, $line);
@reply = ();
($_) = @_;
if (m{(http://)([^/]*)/*(\S*)}) {
$type = $1;
$_ = $2;
$uri = '/'.$3;
$url = "$type$_$uri";
} else {
&errmsg("URL '$_' is munged!");
}
if (/^([^:]*):*(\S*)/) {
$remote = $1;
$port = $2;
} else {
&errmsg("Host '$_' is munged");
}
$port = 80 unless $port;
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
&errmsg('No Port') unless ($port);
$iaddr = inet_aton($remote) || &errmsg("no host: $remote");
$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto) || &errmsg("socket: $!");
connect(SOCK, $paddr) || &errmsg("connect: $!");
select(SOCK);$|=1;
select(STDOUT);
print SOCK "GET $uri HTTP/1.0\n",'Host: ',$remote,"\n";
print SOCK "User-Agent: $ENV{HTTP_USER_AGENT}\n"
if $ENV{HTTP_USER_AGENT};
print SOCK "\n";
while (defined($line = )) { push @reply,$line; }
&errmsg("Connection refused!") unless @reply;
close (SOCK) || &errmsg("close: $!");
}
sub errmsg {
my ($err) = @_;
print "$ENV{SERVER_PROTOCOL} 200 OK\n" if $nph;
print "Content-type: text/html\n\n",
"Error\n",
"ERROR
$err\n";
exit;
}