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