HTTP Get

kinnunen 03.10.01 19:31

Hakee yhden webbisivun headereineen

 Tekstiversio  Arvo: 1 (1 ääntä)  Äänestä: +  -
#!/usr/bin/perl

use Socket; # Vakiot AF_INET, PF_INET, SOCK_STREAM
use strict;

my $sivu = http_get("http://www.sektori.com");
print "\n\n$sivu\n";

#################################################################
# Hakee http-protokollalla yhden weppisivun. Palauttaa stringin,
# jossa http-headerit mukana.

sub http_get($)
{
    if($_[0] !~ m'^(http://)?([0-9A-Z.]+)(:(\d+))?(.*)$'i)
    {
        die "Annoitpa kummallisen urlin, tätä en osaa parsia";
    }
    my $serveri = $2;
    my $portti  = $4 || 80;
    my $sivu    = $5 || "/";

    my $ip  = gethostbyname($serveri);
    my $tcp = getprotobyname('tcp') || 6;
    my $remote = pack("Sna4x8", AF_INET, $portti, $ip);

    socket(my $SOCKET, PF_INET, SOCK_STREAM, $tcp) or die "Socketin luominen ei onnistunut: $!";
    connect($SOCKET, $remote)                      or die "Etäkoneelle ei saatu yhteyttä: $!";

    select($SOCKET); $| = 1; select(STDOUT);     # Socketille autoflush päälle
    binmode($SOCKET);                            # Windowsilla on paha tapa muuttaa \n -> \r\n

    print $SOCKET "GET $sivu HTTP/1.1\r\n",      # Ihan normaalisti printataan requesti sockettiin
                  "User-Agent: PerlGet/0.1\r\n", # HTTP-headerien merkitykset löytyy RFC2616:stä
                  "Host: $serveri\r\n",          # http://www.ietf.org/rfc/rfc2616.txt
                  "Cache-Control: no-cache\r\n",
                  "Accept: *.*, */*\r\n",
                  "Connection: close\r\n\r\n";   # Viimeisen headerin jälkeen \r\n kaksi kertaa

    my $aloitus = time;
    my $lohko = 4096;    # Lukee socketista enintään 4096 tavua kerrallaan (saa muuttaa).
    my $vastaus = "";

    while(sysread($SOCKET, $vastaus, $lohko, length($vastaus)))
    {
        my $kb = length($vastaus)/1024;
        my $kbps = $kb/(time-$aloitus or 1);     # or 1 estää nollalla jaon.
        printf("\r   http://$serveri:$portti$sivu - %.1f KB/s    (%d KB)    ", $kbps, $kb);
    }

        close($SOCKET);
    print "\n";
    return $vastaus;
}

zache 17:00 13.12.02 
Koodissa on pienoinen bugi, sillä sen url parsinta ei toimi oikein jos domainissa on erikoismerkkejä.

Tuon kun vaihtaa

if($_[0] !~ m'^(http://)?([0-9A-Z.]+)(:(\d+))?(.*)$'i)

tuohon

if($_[0] !~ m'^(http://)?(.*?)(:(\d+))?(/.*)$'i)

niin pitäisi toimia