Chip 2000 February/CHIPCD_2_2000.iso/software/shareware/watznew/http.lib

Text File | 1999-11-09 | 4.8 KB | 193 lines

# --------------------------------------------------------
# HTTP ROUTINES LIBRARY by A.I.Studio / Igor Afanasyev
# --------------------------------------------------------

use Socket;

select(STDOUT); $| = 1;

#$UserAgent = 'WatzNew Agent Script';
$UserAgent = 'Mozilla/4.0 (compatible; MSIE 5.0; Win32)';

@Cookies = ();

# -----------------------------------------------------------
sub ConvertHtmlCodes {
# -----------------------------------------------------------
  local ($s) = @_;
  $s =~ s/ / /gi;
  $s =~ s/"/"/gi;
  $s =~ s/</</gi;
  $s =~ s/>/</gi;
  return $s;
} # end of sub

# -----------------------------------------------------------
sub SplitUrl { # splits url to ($Host,$Port,$Path) array
# -----------------------------------------------------------
local ($Url) = @_;

local $Host,$Port,$Path;

if ($Url =~ m|^http(s*?)://(.*)|i) {
  $Secure = ($1 eq 's');
  #$Secure && print "INF: Secure url\n";
  $Host = $2;
  $Port = 80;
  $Path = "/";
  ($Host =~ s|^([^/]+)/(.*)$|$1|) && ($Path = $2);
  ($Host =~ s/:(\d+)$//) && ($Port = $1);
  ($Host =~ s/:(\D+)$//) && ($Port = 80);
  $Path = '/'.$Path;
} else {
  die "ERR: Wrong url syntax: $Url\n";
}
#print "[$Host]--[$Port]--[$Path]\n";

return ($Host,$Port,$Path);
} # end of sub

# -----------------------------------------------------------
sub HttpPost { # sends POST request and returns a page
# -----------------------------------------------------------
local ($Data) = @_;

local ($Host,$Port,$Path,$PostData,$SkipBodyMode) = @_;

local $PostDataLength = length($PostData);

$Path = '/' if ($Path eq '');

print "INF: Looking for $Host\n";

$iaddr = inet_aton($Host) || die "ERR: Can't locate host: $Host\n";
$paddr = sockaddr_in($Port, $iaddr);
$proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "ERR: $!\n";
connect(SOCK, $paddr) || die "ERR: $!\n";

select(SOCK); $| = 1; select(STDOUT);

print "INF: Sending request to server\n";

print SOCK <<"END_OF_REQUEST";
POST $Path HTTP/1.1
Host: $Host
Cache-Control: no-cache
Accept-Charset: windows-1251
User-Agent: $UserAgent
Content-type: application/x-www-form-urlencoded
Content-length: $PostDataLength

$PostData
END_OF_REQUEST

return &ProcessServerResponce($SkipBodyMode);
} # end of sub

# -----------------------------------------------------------
sub HttpGet { # sends GET request and returns a page
# -----------------------------------------------------------
local ($Host,$Port,$Path,$SkipNot200,$SkipAlways) = @_;

$Path = '/' if ($Path eq '');

print "INF: Looking for $Host\n";

$iaddr = inet_aton($Host) || die "ERR: Can't locate host: $Host\n";
$paddr = sockaddr_in($Port, $iaddr);
$proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "ERR: $!\n";
connect(SOCK, $paddr) || die "ERR: $!\n";

select(SOCK); $| = 1; select(STDOUT);

print "INF: Sending request to server\n";

#$TRACE_HEADER && print "Retrieving $Path\n";

print SOCK <<"END_OF_REQUEST";
GET $Path HTTP/1.1
Host: $Host
Cache-Control: no-cache
Accept-Charset: windows-1251
User-Agent: $UserAgent
Connection: close
END_OF_REQUEST

foreach $Cookie (@Cookies) {
  print SOCK "Cookie: $Cookie\n";
  $TRACE_COOKIES && print "Sending Cookie: $Cookie\n";
}

print SOCK "\n";

return &ProcessServerResponce($SkipBodyMode);
} # end of sub


# -----------------------------------------------------------
sub ProcessServerResponce {
# -----------------------------------------------------------
$HttpBody = '';
$HttpHeader = '';

local ($SkipBodyMode) = @_;

$Code = -1;

do {
  do {
    $Responce = <SOCK>;
    $HttpHeader .= $Responce;
    $TRACE_HEADER && print "\t >> $Responce\n";
  } until ($Responce eq '');

  $Code = 0 if ($Responce eq '');
  $HttpHeader =~ m/HTTP\/\d\.\d (\d\d\d) \w+/ && ($Code = $1);

  print "INF: HTTP status code: $Code\n";

  if (($Code ge 100) && ($Code lt 200)) {
    $Code = -1;
  }

} until ($Code ge 0);

# extracting cookies
pos $HttpHeader = 0;
while ($HttpHeader =~ m/Set-Cookie:[ ]*(.*?)\n/gi) {
  my $c = $1;
  #$c =~ s/; expires=.*//;
  #$c =~ s/; path=.*//;
  #$c =~ s/; domain=.*//;
  $c =~ s/;.*//;

  $TRACE_COOKIES && print "Cookie: $c\n";
  push @Cookies, $c;
}

local $skip = ($SkipBodyMode eq always) || ($SkipBodyMode eq undef) && ($Code ne 200);
($SkipBodyMode eq never) && ($skip = undef);

$skip && print "INF: Body skipped\n";

if (!$skip) {
  print "INF: Loading document\n";

  while (my $Responce = <SOCK>) {
    $Responce =~ s/[\r\n]//g;
    $HttpBody .= ' ' . $Responce;
    $TRACE_BODY && print "\t :: $Responce\n";
    $TRACE_PROGRESS && print "INF: ".length($HttpBody)." bytes read\n";
  }
}

close(SOCK) || die "ERR: $!";

return $Code;
} # end of sub

# -----------------------------------------------------------

1; # return true