mirror of
https://git.FreeBSD.org/ports.git
synced 2024-11-13 23:36:08 +00:00
562 lines
17 KiB
Plaintext
562 lines
17 KiB
Plaintext
--- premail.orig Sat Oct 25 02:19:07 1997
|
|
+++ premail Tue Oct 6 18:59:57 1998
|
|
@@ -1,4 +1,4 @@
|
|
-#!/usr/local/bin/perl
|
|
+#!%PERL5% -w
|
|
#
|
|
# premail, an e-mail privacy package
|
|
#
|
|
@@ -85,8 +85,11 @@
|
|
|
|
$config{'rlist-valid'} = 300;
|
|
|
|
-$config{'rlist-url'} = 'http://www.publius.net/rlist';
|
|
-$config{'pubring-url'} = 'http://www.publius.net/pubring.pgp';
|
|
+#$config{'rlist-url'} = 'http://www.publius.net/rlist';
|
|
+#$config{'pubring-url'} = 'http://www.publius.net/pubring.pgp';
|
|
+
|
|
+$config{'rlist-url'} = 'finger:rlist@anon.lcs.mit.edu';
|
|
+$config{'pubring-url'} = 'finger:pubring@anon.lcs.mit.edu';
|
|
$config{'type2-list-url'} = 'http://www.jpunix.com/type2.html';
|
|
$config{'pubring-mix-url'} = 'http://www.jpunix.com/pubring.html';
|
|
|
|
@@ -94,8 +97,12 @@
|
|
|
|
$config{'encrypt'} = 'yes';
|
|
|
|
+my @RELAYS;
|
|
+#@RELAYS = ('anon.lcs.mit.edu');
|
|
+
|
|
# the following config options are for testing only!
|
|
#$config{'debug'} = 'chvy';
|
|
+$config{'debug'} = '';
|
|
|
|
# Global state
|
|
|
|
@@ -112,6 +119,7 @@
|
|
$editfile = ''; # name of file to edit
|
|
$dashoi = 0; # -oi on cmd line
|
|
$more_input = 1;
|
|
+$in_active = 0; # IN handler opened
|
|
$header_sep = '';
|
|
$in_body = ''; # the filename of the input message body
|
|
$prezilla = 0; # special mode for Netscape Navigator 2.1
|
|
@@ -226,7 +234,7 @@
|
|
# Return the name of the real sendmail executable
|
|
if (!defined $config{'sendmail'} || $config{'sendmail'} eq '') {
|
|
# Standard place
|
|
- (-x '/usr/lib/sendmail') && return '/usr/lib/sendmail';
|
|
+ #(-x '/usr/lib/sendmail') && return '/usr/lib/sendmail';
|
|
# Newer BSD-based systems
|
|
(-x '/usr/sbin/sendmail') && return '/usr/sbin/sendmail';
|
|
# Okay, I give up
|
|
@@ -308,6 +316,12 @@
|
|
if ($1 =~ /^[mwpqe]$/) { push (@sendmail_args, $_); }
|
|
} elsif (/^\-od(.)$/) {
|
|
push (@sendmail_args, $_);
|
|
+ } elsif (/^\-[BNRV].+$/) {
|
|
+ push (@sendmail_args, $_);
|
|
+ } elsif (/^\-[BNRV]$/) {
|
|
+ if ($#_ < 0) { &error ("$_ option needs an argument\n"); }
|
|
+ push (@sendmail_args, $_);
|
|
+ push (@sendmail_args, shift);
|
|
} elsif (/^\-f$/) {
|
|
if ($#_ < 0) { &error ("$_ option needs an argument\n"); }
|
|
shift; # discard
|
|
@@ -363,7 +377,7 @@
|
|
&apply_cmdline_configs ();
|
|
if ($config{'preferences'}) {
|
|
$preferences = &tilde_expand ($config{'preferences'});
|
|
- open (PREF, $preferences);
|
|
+ if (open (PREF, $preferences)) {
|
|
while (<PREF>) {
|
|
if (/^\s*\$config\{\"([^\"]+)\"\}\s*\=\s*\"([^\"]*)\"/
|
|
|| /^\s*\$config\{\'([^\']+)\'\}\s*\=\s*\'([^\']*)\'/) {
|
|
@@ -371,10 +385,11 @@
|
|
}
|
|
}
|
|
close (PREF);
|
|
+ }
|
|
}
|
|
&apply_cmdline_configs ();
|
|
if ($config{'addresses'}) {
|
|
- open (ADDR, &tilde_expand ($config{'addresses'}));
|
|
+ if (open (ADDR, &tilde_expand ($config{'addresses'}))) {
|
|
while (<ADDR>) {
|
|
if (/^([\w\-\_\+\.\@\!]+)\:\s*(.*)$/) {
|
|
$recip = &strip_address ($1);
|
|
@@ -382,6 +397,7 @@
|
|
}
|
|
}
|
|
close (ADDR);
|
|
+ }
|
|
}
|
|
if ($config{'logfile'}) {
|
|
open (LOG, '>>'.&tilde_expand_mkdir ($config{'logfile'}));
|
|
@@ -413,6 +429,7 @@
|
|
if (!open (IN, $editfile)) {
|
|
&error ("cannot open edit file $editfile\n");
|
|
}
|
|
+ $in_active = 1;
|
|
return 1;
|
|
} elsif ($dashbs) {
|
|
# do simple SMTP
|
|
@@ -463,7 +480,9 @@
|
|
|
|
@in_headers = ();
|
|
for ($lineno = 0;;$lineno++) {
|
|
- $line = &get_line_body ($body);
|
|
+ if (! defined($line = &get_line_body ($body))) {
|
|
+ last;
|
|
+ }
|
|
if ($handle_from && $lineno == 0 && $line =~ /^From /) {
|
|
return $line;
|
|
}
|
|
@@ -495,16 +514,16 @@
|
|
my $line;
|
|
|
|
if ($edit || $post) {
|
|
- $line = <IN>;
|
|
+ $line = <IN> if ($in_active);
|
|
} elsif ($dashbs) {
|
|
$line = <STDIN>;
|
|
- if ($line eq ".\n") { return undef; }
|
|
+ if (!defined $line || $line eq ".\n") { return undef; }
|
|
$line =~ s/^\.\./\./;
|
|
} else {
|
|
$line = <STDIN>;
|
|
if (!defined $line || !$dashoi && $line eq ".\n") { return undef; }
|
|
}
|
|
- $line =~ s/\r$//;
|
|
+ $line =~ s/\r$// if defined $line;
|
|
return $line;
|
|
}
|
|
|
|
@@ -516,6 +535,7 @@
|
|
# }
|
|
if ($edit || $post) {
|
|
close (IN);
|
|
+ $in_active = 0;
|
|
} elsif ($dashbs) {
|
|
print "250 Message accepted for delivery\n";
|
|
$more_input = 1;
|
|
@@ -600,10 +620,7 @@
|
|
|
|
# suppress cmdline remailers in -t mode; sendmail 8.6.8 manpage '-t'
|
|
if ($dasht) {
|
|
- foreach (@cmdline_recips) {
|
|
-# print ":".&strip_address($_).":\n";
|
|
- $ealias{&strip_address($_)} = '';
|
|
- }
|
|
+ @cmdline_recips = ();
|
|
}
|
|
|
|
@recips = ();
|
|
@@ -1268,7 +1285,7 @@
|
|
my ($body, @the_recips) = @_;
|
|
my ($key_type, $key);
|
|
my (@keys);
|
|
- my ($new_body, $err, $line);
|
|
+ my ($err, $line);
|
|
my (@mime_fields, $prefix, $boundary);
|
|
my ($sign_type, $sign);
|
|
my ($invoc, $errfile);
|
|
@@ -1354,7 +1371,7 @@
|
|
my ($body, @the_recips) = @_;
|
|
my ($key_type, $key);
|
|
my (@keys);
|
|
- my ($new_body, $err, $line);
|
|
+ my ($err, $line);
|
|
my (@mime_fields, $prefix);
|
|
my ($sign_type, $sign);
|
|
my ($invoc, $errfile);
|
|
@@ -1487,6 +1504,16 @@
|
|
} else {
|
|
$num_shuf = 3;
|
|
}
|
|
+ if ($config{"reliability-threshold"}) {
|
|
+ $rel_thres = $config{"reliability-threshold"};
|
|
+ } else {
|
|
+ $rel_thres = 100;
|
|
+ }
|
|
+ if ($config{"latency-threshold"}) {
|
|
+ $lat_thres = $config{"latency-threshold"};
|
|
+ } else {
|
|
+ $lat_thres = 0;
|
|
+ }
|
|
foreach $hop (@chain) {
|
|
if ($hop =~ /^\d+$/) {
|
|
for ($i = 0; $i < $hop; $i++) {
|
|
@@ -1498,8 +1525,14 @@
|
|
|| &member ('eric', @options))) {
|
|
next;
|
|
}
|
|
- $score = $reliability{$remailer};
|
|
- $score -= $latency{$remailer} * 1e-5;
|
|
+ if ( $reliability{$remailer}>=$rel_thres ) {
|
|
+ $score = 100 ;
|
|
+ } else {
|
|
+ $score = $reliability{$remailer};
|
|
+ }
|
|
+ if ( $latency{$remailer}>=$lat_thres ) {
|
|
+ $score -= $latency{$remailer} * 1e-5;
|
|
+ }
|
|
if ($config{'encrypt'} &&
|
|
(&member ('pgp', @options)
|
|
|| &member ('pgp.', @options))) {
|
|
@@ -1511,7 +1544,8 @@
|
|
|| &member ('pgponly', @options)) { next; }
|
|
if ($config{'no-middle'}
|
|
&& &member ('middle', @options)) { next; }
|
|
- if (&member ('reord', @options)) { $score += 0.1; }
|
|
+ if (&member ('reord', @options)
|
|
+ && $rel_thres==100) { $score += 0.1; }
|
|
if (&member ('filter', @options)) { $score -= 10; }
|
|
if (&member ('mon', @options)) { $score -= 10; }
|
|
if ($#new_chain < 0 && !$erb
|
|
@@ -1687,7 +1721,7 @@
|
|
}
|
|
}
|
|
if ($put_open) { close (PUT); }
|
|
- close (GET);
|
|
+ close (WWW);
|
|
}
|
|
}
|
|
|
|
@@ -1817,7 +1851,7 @@
|
|
}
|
|
}
|
|
push (@deliver_headers, "To\: $new_to\n");
|
|
- if ($addl =~ /\.(encrypt\-key\:\s*[^\.]+)(\.|$)/i) {
|
|
+ if (defined $addl && $addl =~ /\.(encrypt\-key\:\s*[^\.]+)(\.|$)/i) {
|
|
$hash = "$1\n".$hash;
|
|
$body = &cat_tail ($body, "\*\*\n");
|
|
}
|
|
@@ -2214,7 +2248,7 @@
|
|
# we know it's sendmail
|
|
$invoc = &bin_sendmail ();
|
|
if ($#sendmail_args >= 0) {
|
|
- $invoc .= ' '.join (' ', $sendmail_args);
|
|
+ $invoc .= ' '.join (' ', @sendmail_args);
|
|
}
|
|
$invoc .= ' -oi';
|
|
foreach $recip (@the_recips) {
|
|
@@ -2252,11 +2286,11 @@
|
|
&close_body ($body);
|
|
if ($post) {
|
|
close (DELIVER);
|
|
- $post = &tilde_expand ($config{'post'});
|
|
- if ($post eq '') {
|
|
- $post = "/usr/lib/mh/post";
|
|
+ my $ppost = &tilde_expand ($config{'post'});
|
|
+ if ($ppost eq '') {
|
|
+ $ppost = "/usr/lib/mh/post";
|
|
}
|
|
- system ($post, @post_args, $tmpfile);
|
|
+ system ($ppost, @post_args, $tmpfile);
|
|
unlink $tmpfile;
|
|
} elsif ($edit && !$prezilla) {
|
|
close (DELIVER);
|
|
@@ -2441,6 +2475,7 @@
|
|
}
|
|
$strip =~ s/^\s+//s;
|
|
$strip =~ s/\s+$//s;
|
|
+ return ($strip, '') if ($config{'no-caret'}) ;
|
|
return ($strip, $caret);
|
|
}
|
|
|
|
@@ -2801,6 +2836,7 @@
|
|
# (@new_dict) = &delete_field ($key, @dict)
|
|
my ($key, @dict) = @_;
|
|
my (@new_dict);
|
|
+ my ($field_key, $field_val);
|
|
|
|
@new_dict = ();
|
|
foreach $field (@dict) {
|
|
@@ -2972,8 +3008,8 @@
|
|
|
|
$data = '';
|
|
if (open (ERRFILE, $file)) {
|
|
- print $_;
|
|
while (<ERRFILE>) {
|
|
+# print $_;
|
|
$data .= $_;
|
|
}
|
|
close (ERRFILE);
|
|
@@ -3040,7 +3076,7 @@
|
|
$pass = '';
|
|
}
|
|
if ($pubring) { $invoc .= ' +pubring='.&shell_quote ($pubring); }
|
|
- $invoc .= ' +comment= -feat';
|
|
+ $invoc .= ' +language=en +comment= -feat';
|
|
if ($sign) {
|
|
$invoc .= 's -u '.&shell_quote ($signuser);
|
|
&load_secrets ();
|
|
@@ -3126,7 +3162,7 @@
|
|
$signuser = '0x';
|
|
$pass = '';
|
|
}
|
|
- $invoc .= ' +comment= -fats +clearsig=on';
|
|
+ $invoc .= ' +language=en +comment= -fats +clearsig=on';
|
|
$invoc .= ' -u '.&shell_quote ($signuser);
|
|
unless (defined $pass) {
|
|
if (defined $pgppass{$signuser}) {
|
|
@@ -3182,7 +3218,7 @@
|
|
$signuser = '0x';
|
|
$pass = '';
|
|
}
|
|
- $invoc .= ' +comment= -fabst';
|
|
+ $invoc .= ' +language=en +comment= -fabst';
|
|
$invoc .= ' -u '.&shell_quote ($signuser);
|
|
unless (defined $pass) {
|
|
if (defined $pgppass{$signuser}) {
|
|
@@ -3238,7 +3274,7 @@
|
|
return ($mimefile, $err, $boundary);
|
|
}
|
|
|
|
-my $PUBRING, $SECRING;
|
|
+my ($PUBRING, $SECRING);
|
|
sub pgp_decrypt {
|
|
# ($out_body, $err) = &pgp_decrypt ($body, $pass)
|
|
# Try to decrypt $body using passphrase $pass. $out_body is null on error.
|
|
@@ -3251,7 +3287,7 @@
|
|
$outfile = &tmp_filename ();
|
|
$errfile = &tmp_filename ();
|
|
$invoc = &tilde_expand ($config{'pgp'});
|
|
- $invoc .= ' +batchmode=on';
|
|
+ $invoc .= ' +language=en +batchmode=on';
|
|
$invoc .= " +pubring=$PUBRING" if $PUBRING;
|
|
$invoc .= " +secring=$SECRING" if $SECRING;
|
|
# if ($pass =~ /^RING$;/) {
|
|
@@ -3299,7 +3335,7 @@
|
|
|
|
$errfile = &tmp_filename ();
|
|
$invoc = &tilde_expand ($config{'pgp'});
|
|
- $invoc .= ' +batchmode=on ';
|
|
+ $invoc .= ' +language=en +batchmode=on ';
|
|
$invoc .= ' '.$pgp_file;
|
|
$invoc .= ' '.$signed_file;
|
|
$invoc .= ' > '.$errfile.' 2>&1';
|
|
@@ -3390,7 +3426,7 @@
|
|
$chars_needed = 2 + sprintf ("%d", $bits / 8);
|
|
&pdv ($config{'pgp'}." +makerandom=$chars_needed $outf"
|
|
." >/dev/null 2>&1\n");
|
|
- $status = system $config{'pgp'}." +makerandom=$chars_needed $outf"
|
|
+ $status = system $config{'pgp'}." +language=en +makerandom=$chars_needed $outf"
|
|
." >/dev/null 2>&1";
|
|
&pdv ($status."\n");
|
|
if (!$status) {
|
|
@@ -3626,11 +3662,14 @@
|
|
|
|
$errfile = &tmp_filename ();
|
|
$invoc = &tilde_expand ($config{'pgp'});
|
|
- $invoc .= ' +batchmode=on -f';
|
|
+ $invoc .= ' +language=en +batchmode=on -f';
|
|
$invoc .= ' < '.$ps_pgp;
|
|
$invoc .= ' > '.$ps;
|
|
$invoc .= ' 2> '.$errfile;
|
|
&pdv ("Invoking PGP as $invoc\n");
|
|
+ if(-e $ps) {
|
|
+ &error ("Premail secrets file already exists\n");
|
|
+ }
|
|
$status = &open_pgp ($invoc, $pass, '');
|
|
$err = &read_and_delete ($errfile);
|
|
&pdv ($err);
|
|
@@ -3647,7 +3686,7 @@
|
|
unlink $ps_pgp;
|
|
}
|
|
$invoc = &tilde_expand ($config{'pgp'});
|
|
- $invoc .= ' +batchmode=on -cf';
|
|
+ $invoc .= ' +language=en +batchmode=on -cf';
|
|
$invoc .= ' < '.$ps;
|
|
$invoc .= ' > '.$ps_pgp;
|
|
$invoc .= ' 2> '.$errfile;
|
|
@@ -3910,7 +3949,8 @@
|
|
&replace_field ('Content-Type: text/plain; charset='
|
|
.$config{'charset'}."\n",
|
|
@deliver_headers);
|
|
- } elsif ($charset =~ /^iso-8859-\d$/i && !$non_ascii) {
|
|
+ } elsif (($charset =~ /^iso-8859-\d$/i || $charset =~ /^koi8-r$/i)
|
|
+ && !$non_ascii) {
|
|
# Should we detect other charsets which are supersets of us-ascii?
|
|
if (!$mv_present) {
|
|
push (@deliver_headers, 'MIME-Version: 1.0'."\n");
|
|
@@ -3923,7 +3963,8 @@
|
|
}
|
|
}
|
|
# must deal with existing cte, charset, etc.
|
|
- if ($non_ascii || $ctrl || $other) {
|
|
+ if ((($non_ascii || $ctrl) && (!$cte_present || lc $cte_val ne '8bit'))
|
|
+ || $other) {
|
|
# Do the QP
|
|
&pdv ("Doing QP encoding!\n");
|
|
if (!$mv_present) {
|
|
@@ -4336,6 +4377,8 @@
|
|
exit 0;
|
|
}
|
|
|
|
+use vars qw($SAVE_BODY);
|
|
+
|
|
sub decode_msg {
|
|
# &decode_msg ($msg)
|
|
# This is possibly the ugliest function in all of premail. Most of it is
|
|
@@ -5129,7 +5172,7 @@
|
|
&load_secrets ();
|
|
foreach (keys %pgpring) {
|
|
my ($tpr, $tsr) = &makerings ($pgpring{$_});
|
|
- system ("$PGP +batchmode +verbose=0 -kx 0x $pr $tpr > /dev/null");
|
|
+ system ("$PGP +language=en +batchmode +verbose=0 -kx 0x $pr $tpr > /dev/null");
|
|
#filecat ($tpr, $pr);
|
|
filecat ($tsr, $sr);
|
|
&delete_tmpfile ($tpr);
|
|
@@ -5157,12 +5200,12 @@
|
|
# &pdv ('&makerings ("'.join ('", "', @_)."\")\n");
|
|
foreach ([$pr, $pk], [$sr, $sk]) {
|
|
open TMP, ">$$_[0]";
|
|
- print TMP $$_[1];
|
|
+ print TMP $$_[1] if defined $$_[1];
|
|
close TMP;
|
|
}
|
|
my $PGP = &tilde_expand ($config{'pgp'});
|
|
foreach $id (@pubkeys) {
|
|
- my $invoc = "$PGP +batchmode +force +verbose=0 -kx "
|
|
+ my $invoc = "$PGP +language=en +batchmode +force +verbose=0 -kx "
|
|
. "$id $pr $pubring 2>&1";
|
|
&pdv ("$invoc > /dev/null\n");
|
|
system "$invoc > /dev/null";
|
|
@@ -5189,7 +5232,7 @@
|
|
$outfile = &tmp_filename ();
|
|
$errfile = &tmp_filename ();
|
|
$invoc = &tilde_expand ($config{'pgp'});
|
|
- $invoc .= ' +batchmode +force +verbose=0 ';
|
|
+ $invoc .= ' +language=en +batchmode +force +verbose=0 ';
|
|
$invoc .= " +pubring=$pr +secring=$sr ";
|
|
$invoc .= $cmd;
|
|
$invoc .= ' < ' . $infile if $infile;
|
|
@@ -5248,7 +5291,7 @@
|
|
EOF
|
|
<STDIN>;
|
|
|
|
- if (system ("$PGP -kg +pubring=$pr +secring=$sr +verbose=0")) {
|
|
+ if (system ("$PGP +language=en -kg +pubring=$pr +secring=$sr +verbose=0")) {
|
|
print STDERR "\nKey generation failed.\n";
|
|
&killbaks ($pr, $sr);
|
|
&delete_open_tmpfiles ();
|
|
@@ -5272,7 +5315,7 @@
|
|
foreach $a ("$kid $pr",
|
|
"$remid $pr " . &tilde_expand ($config{'pubring'}),
|
|
"$kid $sr $defsr") {
|
|
- my $invoc = "$PGP +batchmode +force +verbose=0 -kx $a 2>&1";
|
|
+ my $invoc = "$PGP +language=en +batchmode +force +verbose=0 -kx $a 2>&1";
|
|
# print STDERR "+ $invoc\n";
|
|
my $result = `$invoc`;
|
|
unless ($result =~ /^Key extracted/m) {
|
|
@@ -5300,7 +5343,7 @@
|
|
EOF
|
|
<STDIN>;
|
|
|
|
- my $invoc = "$PGP +secring=$sr -ke $kid $pr";
|
|
+ my $invoc = "$PGP +language=en +secring=$sr -ke $kid $pr";
|
|
# print STDERR "+ $invoc\n";
|
|
if (system ($invoc)) {
|
|
print STDERR "Edit failed.\n";
|
|
@@ -5495,6 +5538,7 @@
|
|
}
|
|
}
|
|
}
|
|
+ $signsend = 'n' unless $signsend;
|
|
if ($#args >= 1) {
|
|
$to = $args[1];
|
|
} elsif ($#args < 0) {
|
|
@@ -5609,7 +5653,6 @@
|
|
$fullname = &query ('Full name of pseudonym (not just '
|
|
. 'E-mail address)', $fullname);
|
|
$fullname =~ s/[\'\^\n]//g; # kludge for secrets file
|
|
- $signsend = 'n' unless $signsend;
|
|
$signsend = &query ('Sign mail with (R)emailer key, '
|
|
. '(P)seudonym key or (N)o key?',
|
|
$signsend);
|
|
@@ -5652,7 +5695,7 @@
|
|
}
|
|
# print "Here's the encrypted block:\n";
|
|
# system "cat $replyblock_fn";
|
|
- $time = time;
|
|
+ $time = CORE::time();
|
|
if (&member ('newnym', @options)) {
|
|
$secret = "\$nym\{\'$time\,$remailer\=$nym\'\} \= ".
|
|
"\'chain=$chain\^to=$to^"
|
|
@@ -5771,6 +5814,7 @@
|
|
if (!open (IN, $body)) {
|
|
&error ("Internal error opening replyblock\n");
|
|
}
|
|
+ $in_active = 1;
|
|
@in_headers = ("To: $to\n");
|
|
push (@in_headers, "Chain: $chain\n") if $chain;
|
|
$header_sep = "\n";
|
|
@@ -5784,6 +5828,7 @@
|
|
}
|
|
&send_group ($groups[0]);
|
|
close (IN);
|
|
+ $in_active = 0;
|
|
}
|
|
|
|
sub find_nym {
|
|
@@ -5997,7 +6042,7 @@
|
|
|
|
# The main loop
|
|
$quit = 0;
|
|
- $inoef = 0;
|
|
+ $ineof = 0;
|
|
while (!$quit) {
|
|
$rin = $win = $ein = '';
|
|
vec ($rin, fileno(STDIN), 1) = 1 unless $ineof;
|
|
@@ -6315,7 +6360,7 @@
|
|
# Open a Web connection for the file as file handle WWW.
|
|
my ($url) = @_;
|
|
my ($host, $port, $suf);
|
|
- my ($fqdn, $aliases, $type, $len, $thataddr);
|
|
+ my ($fqdn, $aliases, $type, $len);
|
|
my ($name, $proto);
|
|
my ($that);
|
|
my ($savesel, $gotsep);
|
|
@@ -6330,7 +6375,7 @@
|
|
$host = $1;
|
|
$port = $2;
|
|
$suf = $3;
|
|
- if ($port =~ /^\:(\d+)$/) { $port = $1; }
|
|
+ if (defined $port && $port =~ /^\:(\d+)$/) { $port = $1; }
|
|
else { $port = 80; }
|
|
($fqdn, $aliases, $type, $len, $thataddr) = gethostbyname ($host);
|
|
return &pdv ("Host not found: $host\n") if ($thataddr eq '');
|
|
@@ -6345,7 +6390,7 @@
|
|
unpack ('C4', $thataddr), $port));
|
|
eval {
|
|
$SIG{'ALRM'} = sub { die "Timeout error on $url\n" };
|
|
- alarm (5);
|
|
+ alarm (10);
|
|
# bind(WWW, $this) || &die_disarm ("bind: $!\n");
|
|
# &pdv ("bound the socket...\n");
|
|
connect(WWW, $that) || &die_disarm ("connect: $!\n");
|
|
@@ -6368,6 +6413,21 @@
|
|
};
|
|
if ($@) { return &pdv ($@); }
|
|
return &pdv ("No response from server\n") unless $gotsep;
|
|
+ } elsif ($url =~ /^finger:(.*)$/) {
|
|
+ my $target = @RELAYS ? $1 . '@' . $RELAYS[CORE::time() % @RELAYS] : $1;
|
|
+ &error("`$target' contains no hostname\n") unless ($target =~ /(.*)@([^@]+)/);
|
|
+ my ($user,$host,$port,$ipaddr,$sin) = ($1, $2);
|
|
+ return &pdv ("Unknown host: $host\n") unless ($ipaddr = inet_aton ($host));
|
|
+ &error ("Internal error: unknown service finger\n")
|
|
+ unless ($port = getservbyname ('finger', 'tcp'));
|
|
+ socket (WWW, PF_INET, SOCK_STREAM, getprotobyname ('tcp'))
|
|
+ || return &pdv ("socket: $!\n");
|
|
+ $sin = sockaddr_in ($port, $ipaddr);
|
|
+ connect (WWW, $sin) || return &pdv ("$! while connecting to $host\n");
|
|
+ &pdv ("connected to the socket...\n");
|
|
+ select ((select(WWW), $|=1)[0]);
|
|
+
|
|
+ print WWW "$user\r\n";
|
|
} else {
|
|
&error ("Misformed URL: $url\n");
|
|
}
|