# $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;