1# Copyright (C) 2008-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 POSIX ':sys_wait_h'; #for WNOHANG in waitpid 12use IO::Handle; 13 14my $UseCache= *GMB::Cache::add{CODE}; 15my $orig_proxy=$ENV{http_proxy}; 16my $gzip_ok; 17BEGIN 18{ eval { require IO::Uncompress::Gunzip; $gzip_ok=1; }; 19} 20 21sub get_with_cb 22{ my $self=bless {}; 23 my %params=@_; 24 $self->{params}=\%params; 25 my ($callback,$url,$post)=@params{qw/cb url post/}; 26 delete $params{cache} unless $UseCache; 27 if (my $cached= $params{cache} && GMB::Cache::get($url)) 28 { warn "cached result\n" if $::debug; 29 Glib::Timeout->add(10,sub { $callback->( ${$cached->{data}}, type=>$cached->{type}, filename=>$cached->{filename}, ); 0}); 30 return $self; 31 } 32 33 warn "simple_http_wget : fetching $url\n" if $::debug; 34 35 my $proxy= $::Options{Simplehttp_Proxy} ? $::Options{Simplehttp_ProxyHost}.':'.($::Options{Simplehttp_ProxyPort}||3128) 36 : $orig_proxy; 37 $ENV{http_proxy}=$proxy; 38 39 my $useragent= $params{user_agent} || 'Mozilla/5.0'; 40 my $accept= $params{'accept'} || ''; 41 my $gzip= $gzip_ok ? '--header=Accept-Encoding: gzip' : ''; 42 my @cmd_and_args= (qw/wget --timeout=40 -S -O -/, $gzip, "--header=Accept: $accept", "--user-agent=$useragent"); 43 push @cmd_and_args, "--referer=$params{referer}" if $params{referer}; 44 push @cmd_and_args, '--post-data='.$post if $post; #FIXME not sure if I should escape something 45 push @cmd_and_args, '--',$url; 46 pipe my($content_fh),my$wfh; 47 pipe my($error_fh),my$ewfh; 48 my $pid=fork; 49 if (!defined $pid) { warn "simple_http_wget : fork failed : $!\n"; Glib::Timeout->add(10,sub {$callback->(); 0}); return $self } 50 elsif ($pid==0) #child 51 { close $content_fh; close $error_fh; 52 open my($olderr), ">&", \*STDERR; 53 open \*STDOUT,'>&='.fileno $wfh; 54 open \*STDERR,'>&='.fileno $ewfh; 55 exec @cmd_and_args or print $olderr "launch failed (@cmd_and_args) : $!\n"; 56 POSIX::_exit(1); 57 } 58 close $wfh; close $ewfh; 59 $content_fh->blocking(0); #set non-blocking IO 60 $error_fh->blocking(0); 61 62 $self->{content_fh}=$content_fh; 63 $self->{error_fh}=$error_fh; 64 $self->{pid}=$pid; 65 $self->{content}=$self->{ebuffer}=''; 66 $self->{watch}= Glib::IO->add_watch(fileno($content_fh),[qw/hup err in/],\&receiving_cb,$self); 67 $self->{ewatch}= Glib::IO->add_watch(fileno($error_fh), [qw/hup err in/],\&receiving_e_cb,$self); 68 69 return $self; 70} 71 72sub receiving_e_cb 73{ my $self=$_[2]; 74 return 1 if read $self->{error_fh},$self->{ebuffer},1024,length($self->{ebuffer}); 75 close $self->{error_fh}; 76 while (waitpid(-1, WNOHANG)>0) {} #reap dead children 77 return $self->{ewatch}=0; 78} 79sub receiving_cb 80{ my $self=$_[2]; 81 return 1 if read $self->{content_fh},$self->{content},1024,length($self->{content}); 82 close $self->{content_fh}; 83 while (waitpid(-1, WNOHANG)>0) {} #reap dead children 84 $self->{pid}=$self->{sock}=$self->{watch}=undef; 85 my $url= $self->{params}{url}; 86 my $callback= $self->{params}{cb}; 87 my $type; my $result=''; 88 $url=$1 while $self->{ebuffer}=~m#^Location: (\w+://[^ ]+)#mg; 89 $type=$1 while $self->{ebuffer}=~m#^ Content-Type: (.*)$#mg; ## 90 $result=$1 while $self->{ebuffer}=~m#^ (HTTP/1\.\d+.*)$#mg; ## 91 #warn $self->{ebuffer}; 92 93 my $filename; 94 while ($self->{ebuffer}=~m#^ Content-Disposition:\s*\w+\s*;\s*filename(\*)?=(.*)$#mgi) 95 { $filename=$2; my $rfc5987=$1; 96 #decode filename, not perfectly, but good enough (http://greenbytes.de/tech/tc2231/ is a good reference) 97 $filename=~s#\\(.)#"\x00".ord($1)."\x00"#ge; 98 my $enc='iso-8859-1'; 99 if ($rfc5987 && $filename=~s#^([A-Za-z0-9_-]+)'\w*'##) {$enc=$1; $filename=::decode_url($filename)} #RFC5987 100 else 101 { if ($filename=~s/^"(.*)"$/$1/) { $filename=~s#\x00(\d+)\x00#chr($1)#ge; $filename=~s#\\(.)#"\x00".ord($1)."\x00"#ge; } 102 elsif ($filename=~m#[^A-Za-z0-9_.\x00-]#) {$filename=''} 103 } 104 $filename=~s#\x00(\d+)\x00#chr($1)#ge; 105 $filename= eval {Encode::decode($enc,$filename)}; 106 } 107 my ($enc)= $self->{ebuffer}=~m#^ Content-Encoding:\s*(.*)#mg; 108 if ($enc) 109 { if ($enc eq 'gzip' && $gzip_ok) 110 { my $gzipped= $self->{content}; 111 IO::Uncompress::Gunzip::gunzip( \$gzipped, \$self->{content} ) 112 or do {warn "simple_http_wget : gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n"; $result='gunzip error';}; 113 } 114 else 115 { warn "simple_http_wget : can't decode '$enc' encoding\n"; 116 $result='encoded'; 117 } 118 } 119 120 if ($result=~m#^HTTP/1\.\d+ 200 OK#) 121 { my $response=\$self->{content}; 122 if ($self->{params}{cache} && defined $$response) 123 { GMB::Cache::add($url,{data=>$response,type=>$type,size=>length($$response),filename=>$filename}); 124 } 125 $callback->($$response,type=>$type,url=>$self->{params}{url},filename=>$filename); 126 } 127 else 128 { warn "Error fetching $url : $result\n"; 129 $callback->(undef,error=>$result); 130 } 131 return $self->{watch}=0; 132} 133 134sub progress 135{ my $self=shift; 136 my $length; 137 $length=$1 while $self->{ebuffer}=~m/Content-Length:\s*(\d+)/ig; 138 my $size= length $self->{content}; 139 my $progress; 140 if ($length && $size) 141 { $progress= $size/$length; 142 $progress=undef if $progress>1; 143 } 144 # $progress is undef or between 0 and 1 145 return $progress,$size; 146} 147 148sub abort 149{ my $self=$_[0]; 150 Glib::Source->remove($self->{watch}) if $self->{watch}; 151 Glib::Source->remove($self->{ewatch}) if $self->{ewatch}; 152 kill INT=>$self->{pid} if $self->{pid}; 153 close $self->{content_fh} if defined $self->{content_fh}; 154 close $self->{error_fh} if defined $self->{error_fh}; 155 while (waitpid(-1, WNOHANG)>0) {} #reap dead children 156 $self->{pid}=$self->{content_fh}=$self->{error_fh}=$self->{watch}=$self->{ewatch}=undef; 157} 158 1591; 160