home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 February / chip-cd_2000_02.zip / 02 / software / shareware / watznew / http.lib < prev    next >
Text File  |  1999-11-09  |  5KB  |  193 lines
  1. # --------------------------------------------------------
  2. # HTTP ROUTINES LIBRARY by A.I.Studio / Igor Afanasyev
  3. # --------------------------------------------------------
  4.  
  5. use Socket;
  6.  
  7. select(STDOUT); $| = 1; 
  8.  
  9. #$UserAgent = 'WatzNew Agent Script';
  10. $UserAgent = 'Mozilla/4.0 (compatible; MSIE 5.0; Win32)';
  11.  
  12. @Cookies = ();
  13.  
  14. # -----------------------------------------------------------
  15. sub ConvertHtmlCodes {
  16. # -----------------------------------------------------------
  17.   local ($s) = @_;
  18.   $s =~ s/ / /gi;
  19.   $s =~ s/"/"/gi;
  20.   $s =~ s/</</gi;
  21.   $s =~ s/>/</gi;
  22.   return $s;
  23. } # end of sub
  24.  
  25. # -----------------------------------------------------------
  26. sub SplitUrl { # splits url to ($Host,$Port,$Path) array
  27. # -----------------------------------------------------------
  28. local ($Url) = @_;
  29.  
  30. local $Host,$Port,$Path;
  31.  
  32. if ($Url =~ m|^http(s*?)://(.*)|i) {
  33.   $Secure = ($1 eq 's');
  34.   #$Secure && print "INF: Secure url\n";
  35.   $Host = $2;
  36.   $Port = 80;
  37.   $Path = "/";
  38.   ($Host =~ s|^([^/]+)/(.*)$|$1|) && ($Path = $2);
  39.   ($Host =~ s/:(\d+)$//) && ($Port = $1);
  40.   ($Host =~ s/:(\D+)$//) && ($Port = 80);
  41.   $Path = '/'.$Path;
  42. } else {
  43.   die "ERR: Wrong url syntax: $Url\n";
  44. }
  45. #print "[$Host]--[$Port]--[$Path]\n";
  46.  
  47. return ($Host,$Port,$Path);
  48. } # end of sub
  49.  
  50. # -----------------------------------------------------------
  51. sub HttpPost { # sends POST request and returns a page
  52. # -----------------------------------------------------------
  53. local ($Data) = @_;
  54.  
  55. local ($Host,$Port,$Path,$PostData,$SkipBodyMode) = @_;
  56.  
  57. local $PostDataLength = length($PostData);
  58.  
  59. $Path = '/' if ($Path eq '');
  60.  
  61. print "INF: Looking for $Host\n";
  62.  
  63. $iaddr = inet_aton($Host) || die "ERR: Can't locate host: $Host\n";
  64. $paddr = sockaddr_in($Port, $iaddr);
  65. $proto = getprotobyname('tcp');
  66. socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "ERR: $!\n";
  67. connect(SOCK, $paddr) || die "ERR: $!\n";
  68.  
  69. select(SOCK); $| = 1; select(STDOUT);
  70.  
  71. print "INF: Sending request to server\n";
  72.  
  73. print SOCK <<"END_OF_REQUEST";
  74. POST $Path HTTP/1.1
  75. Host: $Host
  76. Cache-Control: no-cache
  77. Accept-Charset: windows-1251
  78. User-Agent: $UserAgent
  79. Content-type: application/x-www-form-urlencoded
  80. Content-length: $PostDataLength
  81.  
  82. $PostData
  83. END_OF_REQUEST
  84.  
  85. return &ProcessServerResponce($SkipBodyMode);
  86. } # end of sub
  87.  
  88. # -----------------------------------------------------------
  89. sub HttpGet { # sends GET request and returns a page
  90. # -----------------------------------------------------------
  91. local ($Host,$Port,$Path,$SkipNot200,$SkipAlways) = @_;
  92.  
  93. $Path = '/' if ($Path eq '');
  94.  
  95. print "INF: Looking for $Host\n";
  96.  
  97. $iaddr = inet_aton($Host) || die "ERR: Can't locate host: $Host\n";
  98. $paddr = sockaddr_in($Port, $iaddr);
  99. $proto = getprotobyname('tcp');
  100. socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "ERR: $!\n";
  101. connect(SOCK, $paddr) || die "ERR: $!\n";
  102.  
  103. select(SOCK); $| = 1; select(STDOUT);
  104.  
  105. print "INF: Sending request to server\n";
  106.  
  107. #$TRACE_HEADER && print "Retrieving $Path\n";
  108.  
  109. print SOCK <<"END_OF_REQUEST";
  110. GET $Path HTTP/1.1
  111. Host: $Host
  112. Cache-Control: no-cache
  113. Accept-Charset: windows-1251
  114. User-Agent: $UserAgent
  115. Connection: close
  116. END_OF_REQUEST
  117.  
  118. foreach $Cookie (@Cookies) {
  119.   print SOCK "Cookie: $Cookie\n";
  120.   $TRACE_COOKIES && print "Sending Cookie: $Cookie\n";
  121. }
  122.  
  123. print SOCK "\n";
  124.  
  125. return &ProcessServerResponce($SkipBodyMode);
  126. } # end of sub
  127.  
  128.  
  129. # -----------------------------------------------------------
  130. sub ProcessServerResponce {
  131. # -----------------------------------------------------------
  132. $HttpBody = '';
  133. $HttpHeader = '';
  134.  
  135. local ($SkipBodyMode) = @_;
  136.  
  137. $Code = -1;
  138.  
  139. do {
  140.   do {
  141.     $Responce = <SOCK>;
  142.     $HttpHeader .= $Responce;
  143.     $TRACE_HEADER && print "\t >> $Responce\n";
  144.   } until ($Responce eq '');
  145.  
  146.   $Code = 0 if ($Responce eq '');
  147.   $HttpHeader =~ m/HTTP\/\d\.\d (\d\d\d) \w+/ && ($Code = $1);
  148.  
  149.   print "INF: HTTP status code: $Code\n";
  150.  
  151.   if (($Code ge 100) && ($Code lt 200)) {
  152.     $Code = -1;
  153.   }
  154.  
  155. } until ($Code ge 0);
  156.  
  157. # extracting cookies
  158. pos $HttpHeader = 0;
  159. while ($HttpHeader =~ m/Set-Cookie:[ ]*(.*?)\n/gi) {
  160.   my $c = $1;
  161.   #$c =~ s/; expires=.*//;
  162.   #$c =~ s/; path=.*//;
  163.   #$c =~ s/; domain=.*//;
  164.   $c =~ s/;.*//;
  165.  
  166.   $TRACE_COOKIES && print "Cookie: $c\n";
  167.   push @Cookies, $c;
  168. }
  169.  
  170. local $skip = ($SkipBodyMode eq always) || ($SkipBodyMode eq undef) && ($Code ne 200);
  171. ($SkipBodyMode eq never) && ($skip = undef);
  172.  
  173. $skip && print "INF: Body skipped\n";
  174.  
  175. if (!$skip) {
  176.   print "INF: Loading document\n";
  177.  
  178.   while (my $Responce = <SOCK>) {
  179.     $Responce =~ s/[\r\n]//g;
  180.     $HttpBody .= ' ' . $Responce;
  181.     $TRACE_BODY && print "\t :: $Responce\n";
  182.     $TRACE_PROGRESS && print "INF: ".length($HttpBody)." bytes read\n";
  183.   }
  184. }
  185.  
  186. close(SOCK) || die "ERR: $!";
  187.  
  188. return $Code;
  189. } # end of sub
  190.  
  191. # -----------------------------------------------------------
  192.  
  193. 1; # return true