1# Copyright (C) 2005-2011 Quentin Sculo <squentin@free.fr> 2# 3# This file is part of Gmusicbrowser. 4# Gmusicbrowser is free software; you can redistribute it and/or modify 5# it under the terms of the GNU General Public License version 3, as 6# published by the Free Software Foundation 7 8package Simple_http; 9use strict; 10use warnings; 11use Socket;# 1.3; ? 12use Fcntl; 13use IO::Handle; 14 15use constant { EOL => "\015\012" }; 16my %ipcache; #FIXME purge %ipcache from time to time 17my $UseCache= *GMB::Cache::add{CODE}; 18 19my $gzip_ok; 20BEGIN 21{ eval { require IO::Uncompress::Gunzip; $gzip_ok=1; }; 22} 23 24sub get_with_cb 25{ my $self=bless {}; 26 my $error; 27 if (ref $_[0]) {$self=shift; $error='Too many redirections' if 5 < $self->{redirect}++; } 28 my %params=@_; 29 $self->{params}=\%params; 30 delete $params{cache} unless $UseCache; 31 my ($callback,$url,$post)=@params{qw/cb url post/}; 32 if (my $cached= $params{cache} && GMB::Cache::get($url)) 33 { warn "cached result\n" if $::debug; 34 Glib::Timeout->add(10,sub { $callback->( ${$cached->{data}}, type=>$cached->{type}, filename=>$cached->{filename}, ); 0}); 35 return $self; 36 } 37 warn "simple_http : fetching $url\n" if $::debug; 38 39 my ($host,$port,$file); 40 my $socket; 41 { last if $error; 42 43 if ( $url=~s#^([a-z]+)://## && $1 ne 'http' ) 44 { $error="Protocol $1 not supported"; last; } 45 ($host,$port,$file)= $url=~m#^([^/:]+)(?::(\d+))?(.*)$#; 46 if (defined $host) 47 { $port=80 unless defined $port; 48 $file='/' if $file eq ''; 49 } 50 else { $error='Bad url : http://'.$url; last; } 51 52 my $proxyhost=$::Options{Simplehttp_ProxyHost}; 53 if ($::Options{Simplehttp_Proxy} && defined $proxyhost && $proxyhost ne '') 54 { $file="http://$host:".$port.$file; 55 $host=$proxyhost; 56 $port=$::Options{Simplehttp_ProxyPort}; 57 $port=80 unless defined $port && $port=~m/^\d+$/; 58 } 59 my $addr; 60 if ($host=~m#^\d+\.\d+\.\d+.\d+$#) {$addr=inet_aton($host);} 61 else { $addr=$ipcache{$host}||=inet_aton($host)}#FIXME not asynchronous, use a fork ? 62 unless ($addr) 63 { $error="Can't resolve host $host"; last; } 64 socket($socket, PF_INET, SOCK_STREAM, getprotobyname('tcp')); 65 my $paddr=pack_sockaddr_in(0, INADDR_ANY); 66 unless ( bind $socket,$paddr ) 67 { $error=$!; last; } 68 $self->{file}=$file; 69 $self->{port}=$port; 70 $self->{host}=$host; 71 my $sin=sockaddr_in($port,$addr); 72 fcntl $socket,F_SETFL,O_NONBLOCK; #unless $^O eq "MSWin32" 73 connect $socket,$sin; 74 } 75 $self->{sock}=$socket; 76 if (defined $error) 77 { $error="Cannot connect to server $host:$port : $error" if $host; 78 warn "$error\n"; 79 Glib::Timeout->add(10,sub { $callback->(undef,error=>$error); 0 }); 80 return $self; 81 } 82 $self->{buffer}=''; 83 $self->{watch}=Glib::IO->add_watch(fileno($socket),['out','hup'],\&connecting_cb,$self); 84 85 return $self; 86} 87 88sub connecting_cb 89{ my $failed= ($_[1] >= 'hup'); #connection failed 90 my $self=$_[2]; 91 my $socket=$self->{sock}; 92 my $port=$self->{port}; 93 my $host=$self->{host}; 94 my $params= $self->{params}; 95 96 if ($failed) 97 { warn "Cannot connect to server $host:$port\n"; 98 close $socket; 99 $params->{cb}(undef,error=>"Connection failed"); 100 return 0; 101 } 102 103#binmode $socket,':encoding(iso-8859-1)'; 104 my $post=$params->{post}; 105 my $method=defined $post ? 'POST' : 'GET'; 106 my $useragent= $params->{user_agent} || 'Mozilla/5.0'; 107 my $accept= $params->{'accept'} || ''; 108 print $socket "$method $self->{file} HTTP/1.0".EOL; 109 print $socket "Host: $host:$port".EOL; 110 print $socket "User-Agent: $useragent".EOL; 111 print $socket "Referer: $params->{referer}".EOL if $params->{referer}; 112 print $socket "Accept: $accept".EOL; 113 print $socket "Accept-Encoding: gzip".EOL if $gzip_ok; 114 #print $socket "Connection: Keep-Alive".EOL; 115 if (defined $post) 116 { print $socket 'Content-Type: application/x-www-form-urlencoded; charset=utf-8'.EOL; 117 print $socket "Content-Length: ".length($post).EOL.EOL; 118 print $socket $post.EOL; 119 } 120 print $socket EOL; 121 122 $socket->autoflush(1); 123 $self->{buffer}=''; 124 $self->{watch}=Glib::IO->add_watch(fileno($socket),['in','hup'],\&receiving_cb,$self); 125 126 return 0; 127} 128 129sub progress 130{ my $self=shift; 131 my ($length)= $self->{buffer}=~m/\015\012Content-Length:\s*(\d+)\015\012/i; 132 my $pos= index $self->{buffer}, EOL.EOL; 133 my $progress; 134 my $size=0; 135 if ($pos>=0) 136 { $size=length($self->{buffer})-2-$pos; 137 if ($length) 138 { $progress= $size/$length; 139 $progress=undef if $progress>1; 140 } 141 } 142 # $progress is undef or between 0 and 1 143 return $progress,$size; 144} 145 146sub receiving_cb 147{ my $self=$_[2]; 148 return 1 if read $self->{sock},$self->{buffer},1024,length($self->{buffer}); 149 close $self->{sock}; 150 $self->{sock}=$self->{watch}=undef; 151 #warn "watch done\n"; 152 my $url=$self->{params}{url}; 153 my $callback=$self->{params}{cb}; 154 my $EOL=EOL; 155 my ($headers,$response)=split /$EOL$EOL/o,delete $self->{buffer},2; 156 $headers='empty answer' unless defined $headers; 157 (my$result,$headers)=split /$EOL/o,$headers,2; 158 if ($::debug) 159 { warn "0|$_\n" for $result,split /$EOL/o,$headers; 160 } 161 $headers.=EOL; 162 my %headers; 163 $headers{lc $1}=$2 while $headers=~m/([^:]*): (.*?)$EOL/og; 164 165 my $filename; 166 if ($headers{'content-disposition'} && $headers{'content-disposition'}=~m#^\s*\w+\s*;\s*filename(\*)?=(.*)$#mgi) 167 { $filename=$2; my $rfc5987=$1; 168 #decode filename, not perfectly, but good enough (http://greenbytes.de/tech/tc2231/ is a good reference) 169 $filename=~s#\\(.)#"\x00".ord($1)."\x00"#ge; 170 my $enc='iso-8859-1'; 171 if ($rfc5987 && $filename=~s#^([A-Za-z0-9_-]+)'\w*'##) {$enc=$1; $filename=::decode_url($filename)} #RFC5987 172 else 173 { if ($filename=~s/^"(.*)"$/$1/) { $filename=~s#\x00(\d+)\x00#chr($1)#ge; $filename=~s#\\(.)#"\x00".ord($1)."\x00"#ge; } 174 elsif ($filename=~m#[^A-Za-z0-9_.\x00-]#) {$filename=''} 175 } 176 $filename=~s#\x00(\d+)\x00#chr($1)#ge; 177 $filename= eval {Encode::decode($enc,$filename)}; 178 } 179 if (my $enc=$headers{'content-encoding'}) 180 { if ($enc eq 'gzip' && $gzip_ok) 181 { my $gzipped= $response; 182 IO::Uncompress::Gunzip::gunzip( \$gzipped, \$response ) 183 or do {warn "simple_http : gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n"; $result='gunzip error';}; 184 } 185 else 186 { warn "simple_http_wget : can't decode '$enc' encoding\n"; 187 $result='gzipped'; 188 } 189 } 190 if ($result=~m#^HTTP/1\.\d+ 200 OK#) 191 { #warn "ok $url\n$callback\n"; 192 my $type=$headers{'content-type'}; 193 if ($self->{params}{cache} && defined $response) 194 { GMB::Cache::add($url,{data=>\$response,type=>$type,size=>length($response),filename=>$filename}); 195 } 196 $callback->($response, type=>$type, url=>$self->{params}{url}, filename=>$filename); 197 } 198 elsif ($result=~m#^HTTP/1\.\d+ 30[123]# && $headers{location}) #redirection 199 { my $url=$headers{location}; 200 unless ($url=~m#^http://#) 201 { my $base=$self->{params}{url}; 202 if ($url=~m#^/#){$base=~s#^(?:http://)?([^/]+).*$#$1#;} 203 else {$base=~s#[^/]*$##;} 204 $url=$base.$url; 205 } 206 $self->{params}{url}=$url; 207 $self->get_with_cb( %{$self->{params}} ); 208 } 209 else 210 { warn "Error fetching $url : $result\n"; 211 $callback->(undef,error=>$result); 212 } 213 return 0; 214} 215 216sub abort 217{ my $self=$_[0]; 218 Glib::Source->remove($self->{watch}) if defined $self->{watch}; 219 close $self->{sock} if defined $self->{sock}; 220 $self->{sock}=$self->{watch}=undef; 221} 222 2231; 224