# $Id: Link.pm,v 1.2 2001/02/03 16:22:54 muhri Exp $
# -*- perl -*-
package Pronto::Link;
use strict;
use IO::Socket;
sub load_url {
my ($html, $url, $handle) = @_;
my ($io, $d, $path, $port, $host, $socket, $answer, $header, $length, $xferencode, $status, $st_num);
unless ($url =~ /^\w+:/) {
if ($io = new IO::File($url)) {
$io->read($d, 1000000);
$html->write($handle, $d);
$io->close;
$html->end($handle, 'ok');
} else {
$html->end($handle, 'error');
}
return 1;
}
$answer = "";
$header ="";
$url =~ /http:\/\/([\w\.-]+)([:\d]*)(.*)/;
if (!$3) { $path = "/"; } else { $path = $3; }
if (!$2) { $port = 80; } else { $port = $2; }
if (!$1) { return 1; } else { $host = $1; }
if ($main::prefs{'Proxy'}) {
$socket = IO::Socket::INET->new(PeerAddr => $main::prefs{'Proxy'}, PeerPort => $main::prefs{'ProxyPort'}, Proto => "TCP", Timeout => "30", Type => SOCK_STREAM) or return 1;
print $socket "GET $url HTTP/1.1\r\nHost: $host\r\nUser-Agent: Pronto/$main::version\r\nConnection: close\r\n\r\n";
} else {
$socket = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $port, Proto => "TCP", Timeout => "30", Type => SOCK_STREAM) or return 1;
print $socket "GET $path HTTP/1.1\r\nHost: $host\r\nUser-Agent: Pronto/$main::version\r\nConnection: close\r\n\r\n";
}
CONTINUE:
$status = <$socket>;
$status =~ /HTTP\/\d.\d (\d+)/ and $st_num = $1;
while (defined $answer and $answer ne "\n") {
$answer = <$socket>;
if ($answer) {
$answer =~ s/\r//g;
$header.= $answer;
}
}
if ($st_num == 301 || $st_num ==302) {
$header =~ /\nLocation: ?(.+)/i and $url = $1;
&load_url($html, $url, $handle);
return 1;
} elsif ($st_num == 100) {
goto CONTINUE;
} elsif ($st_num != 200) {
&main::err_dialog("$status");
return 1;
}
print ("$header\n");
$header =~ /Content-Length: ?(\d+)/i and $length = $1;
$header =~ /Transfer-Encoding: ?(.+)/i and $xferencode = $1;
if (defined $xferencode && $xferencode =~ /chunked/) {
my ($body, $line);
$/ = "\r\n";
$line = <$socket>;
$/ = "\n";
$line =~ /^(\w+)/ and $length = $1;
while (hex($length) > 0) {
while (Gtk->events_pending) { Gtk->main_iteration; }
$socket->read($d, hex($length));
$body.=$d;
$/ = "\r\n";
$line = <$socket>;
$line = <$socket>;
$length = 0;
$line =~ /^(\w+)/ and $length = $1;
$/ = "\n";
}
$html->write($handle, $body);
} else {
if (defined $length && $length > 8192) {
my $numfullpackets = int($length/8192);
my $lastpacket = $length - ($numfullpackets * 8192);
for (my $i = 1; $i <= $numfullpackets; $i++) {
while (Gtk->events_pending) {
Gtk->main_iteration;
}
$socket->read($d, 8192);
$html->write($handle, $d);
}
$socket->read($d, $lastpacket);
} else {
$socket->read($d, 8192);
}
$html->write($handle, $d);
}
$html->end($handle, 'ok');
return 1;
}
sub link_clicked {
if (!-f $main::prefs{'ViewerPath'}) {
&main::err_dialog(_("Please set your viewer path correctly in Pronto's config! "));
return 1;
}
if ($main::HTMLWIDGET eq "XmHTML") {
my ($widget, $info) = @_;
my (@fields, $address);
if (($info->{"urltype"} eq "http") or ($info->{"urltype"} eq "ftp")) {
my ($cmd,$bug);
my $url = $info->{"href"};
if ($main::prefs{'ViewerPath'} =~ /netscape/) {
$cmd = $main::prefs{'ViewerPath'} . " -remote 'OpenURL($url, new_window)'";
} else {
$cmd = $main::prefs{'ViewerPath'} . " \"$url\"";
}
if ($main::prefs{'ViewerPath'} =~ /netscape/) {
$bug = system($cmd);
if ($bug != 0) {
my ($child);
unless ($child = fork) {
die "cannot fork: $~" unless defined $child;
exec($main::prefs{'ViewerPath'}." \"$url\"");
}
}
} else {
my ($child);
unless ($child = fork) {
die "cannot fork: $~" unless defined $child;
exec($main::prefs{'ViewerPath'}. " \"$url\"");
}
}
} elsif ($info->{"href"} =~ /mailto:/) {
$info->{"href"} =~ /mailto:(.+)/ and $address = $1;
$fields[0] = $address;
$fields[1] = "";
$fields[2] = "";
&Pronto::Compose::init_msg_window(0, undef, \@fields);
} elsif ($info->{"href"} =~ /^file:$main::prefs{'MailDir'}\/tmp\//) {
my ($temp,$filename,$source,$type);
($temp,$source,$type) = split(/:/,$info->{"href"});
if($main::prefs{'attachLeftView'} eq 'y') {
&Pronto::ViewAttachment::view_attachment(undef,$source,$type,'y');
} else {
$filename = $source;
$filename =~ s/^file:$main::prefs{'MailDir'}\/tmp\///g;
&Pronto::Save::init_fs_window(undef,$filename,$source);
}
}
} else {
my ($widget, $url) = @_;
my ($cmd,$bug);
if ($main::prefs{'ViewerPath'} =~ /netscape/) {
$cmd = $main::prefs{'ViewerPath'} . " -remote 'OpenURL($url, new_window)'";
} else {
$cmd = $main::prefs{'ViewerPath'} . " \"$url\"";
}
if ($main::prefs{'ViewerPath'} =~ /netscape/) {
$bug = system($cmd);
if ($bug != 0) {
my ($child);
unless ($child = fork) {
die "cannot fork: $~" unless defined $child;
exec($main::prefs{'ViewerPath'}." \"$url\"");
}
}
} else {
my ($child);
unless ($child = fork) {
die "cannot fork: $~" unless defined $child;
exec($main::prefs{'ViewerPath'}. " \"$url\"");
}
}
}
1;
}
sub gtkhtml_link_clicked {
my($window,$url) = @_;
if ($url =~ /^mailto:(.+)/) {
my ($address, @fields);
$address = $1;
$fields[0] = $address;
$fields[1] = "";
$fields[2] = "";
&Pronto::Compose::init_msg_window(0, undef, \@fields);
return 1;
}
elsif ($url =~ /^file:$main::prefs{'MailDir'}\/tmp\//) {
my ($temp,$filename,$source,$type);
($temp,$source,$type) = split(/:/,$url);
if($main::prefs{'attachLeftView'} eq 'y') {
&Pronto::ViewAttachment::view_attachment(undef,$source,$type,'y');
}
else {
$filename = $source;
$filename =~ s/^file:$main::prefs{'MailDir'}\/tmp\///g;
&Pronto::Save::init_fs_window(undef,$filename,$source);
}
}
elsif ($main::prefs{'useAlternateViewer'} eq "y") {
&link_clicked(undef, $url);
return 1;
}
else {
&browse($url);
return 1;
}
}
sub browse {
my ($url) = @_;
my $child;
unless ($child = fork) {
die "cannot fork: $~" unless defined $child;
exec("prontobrowser \"$url\"")
}
}
1;
syntax highlighted by Code2HTML, v. 0.9.1