#!/usr/bin/perl
# If required, adjust line above to point to Perl 5.
######################################################################
# fantomas getFrog(TM) - LinkTopper(TM) Internet Directory Edition #
######################################################################
#$vers = "ver. 01.01.02-e"; # 2000-09-18 #
######################################################################
# (c) Copyright 2000 by fantomaster.com #
# All rights reserved. #
# Copying, modification or distribution requires permission #
# in writing by copyright holder. #
# fantomas getFrog(TM) is the protected trade mark of #
# fantomaster.com #
# For inquiries, licensing, etc. please contact: #
# URL: #
######################################################################
# (c) 2000 Copyright LinkTopper(TM) #
# by searchenginebase.com All rights reserved. #
# Copying, modification or distribution requires permission #
# in writing by copyright holder. #
# LinkTopper(TM) is the protected trade mark of #
# searchenginebase.com #
# For inquiries, licensing, etc. please contact: #
# URL: #
######################################################################
######################################################################
############## NO EDITING BEYOND THIS LINE REQUIRED! ###############
######################################################################
use Socket;
$user_agent = "fantomas getFrog(TM)";
$referer = "$ENV{'HTTP_REFERER'}";
$url = "http://64.37.114.38/sblinks.html";
@url = &parse_url($url);
@html_page = &get_url(IN, @url);
print "Content-type: text/html\n\n";
print @html_page;
exit;
######################################################################
##################### Subprogram Parse URL #########################
######################################################################
sub parse_url {
my($url) = @_;
my($protocol, $host, $port, $path);
if ($url =~ m%(([^:]+):)?(//([^/:]+))?(:(\d+))?([^#]*)?(#.*)?$%) {
($protocol, $host, $port, $path) = ($2, $4, $6, $7);
$path = "/" if !defined($path) or ($path eq '');
if ($protocol =~ /^http$/i) {$port = 80;}
}
return ($protocol, $host, $port, $path);
}
######################################################################
###################### Subprogram Get URL ##########################
######################################################################
sub get_url {
local(*FD, @url) = @_;
my($protocol, $host, $port, $path) = @url;
$error = &connect_to_server(SD, $host, $port)
and return $error;
put(SD,"GET $path HTTP/1.0\n");
put(SD,"User-Agent: $user_agent\n");
put(SD,"Referer: $referer\n\n");
@html_page = get(SD);
return @html_page;
}
######################################################################
################# Subprogram Connect to Server #####################
######################################################################
sub connect_to_server {
local(*SD, $host, $port) = @_;
my($server) = &get_socket_address($host,$port);
return "Host $host unknown" if !defined $server;
socket(SD, PF_INET, SOCK_STREAM, 0)
or return "Error in socket: $!";
connect(SD, $server)
or return "Error in connect: $!";
my($old) = select(SD); $| = 1; select($old); binmode(SD);
$_buffer_ = "";
return undef;
}
######################################################################
################# Subprogram Get Socket Address #####################
######################################################################
sub get_socket_address {
my($host, $port) = @_;
unless (exists $addr{$host,$port}) {
my($addr) = (gethostbyname($host))[4];
return undef if !defined $addr;
$addr{$host,$port} = pack('S n a4 x8', AF_INET,$port,$addr);
}
return $addr{$host,$port};
}
######################################################################
####################### Subprogram Get Data #########################
######################################################################
sub get {
local(*SD) = @_;
my($i,$pos,$tmp);
@html_page = ();
$body = ();
$eof = ();
$i = 0;
while (! $eof) {
while (($pos = index($_buffer_,"\n")) < 0) {
recv(SD,$tmp,2048,0);
unless ($tmp eq '') {
$_buffer_ .= $tmp;
}
else {
$_buffer_ .= "\n";
$eof = 1;
}
}
if (! $body) {
if ($_buffer_ =~ /^HTTP\S+\s+(\d+)\s*(.*)/i) {
my ($error_code, $error_text) = ($1, $2);
if ($error_code != 200) {
chop $error_text;
return "$url[0]://$url[1]$url[3]: $error_text (code = $error_code)";
}
}
if (substr($_buffer_,0,$pos+1) =~ /^\r?$/){
$body = 1;
}
}
else {
$html_page[$i] = substr($_buffer_,0,$pos+1);
}
substr($_buffer_,0,$pos+1) = "";
$i++;
}
return @html_page;
}
######################################################################
##################### Subprogram Send Data ##########################
######################################################################
sub put {
local(*SD,$msg) = @_;
send(SD,$msg,0);
}
######################################################################
Fast Networx Hauptseite
Google
Altavista
Fireball