/[docman]/contrib/email2htusers.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /contrib/email2htusers.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Sat Feb 16 22:33:11 2002 UTC (22 years, 1 month ago) by dpavlin
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +28 -13 lines
File MIME type: text/plain
don't reuse TCP connection. This will solve sendmail slowdown (which is
actaully a anti-spam feature)

1 dpavlin 1.1 #!/usr/bin/perl -w
2    
3     # 2001-03-05 Dobrica Pavlinusic <dpavlin@rot13.org>
4     #
5     # reads e-mail addresses from stdin and dump format for .htusers on stdout
6     # which will use auth_pop3 for user authentification
7     #
8     # This tool is good for batch import and it will do it's best to resolve
9     # all sendmail related output from expn. However, it's not tested on
10     # other mailers.
11     #
12     # usage:
13     #
14     # cat emails.txt | email2htusers.pl [remote.smtp.server] [smtp_port] >> .htusers
15     #
16    
17     use strict;
18     use Socket;
19    
20     my $debug=0;
21    
22 dpavlin 1.3 my $reuse_conn=0; # if you set this to 1, it will try to do all expn
23     # over single tcp connection. It nice to smtp server,
24     # but sendmail slows down after 10 expns or so...
25    
26 dpavlin 1.1 my ($remote,$port, $iaddr, $paddr, $proto, $line);
27    
28 dpavlin 1.3 $remote = shift || 'localhost';
29 dpavlin 1.1 $port = shift || 25;
30    
31     print "# using remote $remote port $port\n" if ($debug);
32    
33 dpavlin 1.3 sub open_conn {
34     if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
35     die "No port" unless $port;
36     $iaddr = inet_aton($remote) || die "no host: $remote";
37     $paddr = sockaddr_in($port, $iaddr);
38    
39     $proto = getprotobyname('tcp');
40     socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
41     connect(SOCK, $paddr) || die "connect: $!";
42     select(SOCK); $|=1;
43     select(STDOUT); $|=1;
44    
45     my $hello=<SOCK>; # hello
46    
47     }
48 dpavlin 1.1
49 dpavlin 1.3 sub close_conn {
50     close (SOCK) || die "close: $!";
51     }
52 dpavlin 1.1
53     my %tested;
54    
55     sub try_expn {
56     my $login=$_[0];
57     if (! defined($tested{$login})) {
58     $tested{$login}++;
59     print SOCK "expn $login\n";
60     my $response=<SOCK>;
61     while ($response =~ /^2\d\d-(.+)/) {
62     my $rest=$1;
63     print "# $response\n" if ($debug);
64 dpavlin 1.2 if ($rest=~/[\d\. ]+([^<]+) <\\*(\w+)\@($remote[^>]*)>/) {
65     print "# $2:$1:auth_pop3:$2\@$3\n";
66 dpavlin 1.1 }
67     $response=<SOCK>;
68     };
69     print "# $response\n" if ($debug);
70     if ($response =~ /^2\d\d (.+)/) {
71     my $rest=$1;
72 dpavlin 1.2 if ($rest=~/[\d\. ]+([^<]+) <\\*(\w+)\@($remote[^>]*)>/) {
73     print "$2:$1:auth_pop3:$2\@$3\n";
74 dpavlin 1.1 }
75     } else {
76     print "# can't add e-mail address $login\n";
77     }
78     return 0;
79     }
80     }
81    
82 dpavlin 1.3 open_conn if ($reuse_conn);
83    
84 dpavlin 1.2 while(<STDIN>) {
85 dpavlin 1.1 chomp;
86     next if (/^#/ || /^$/);
87 dpavlin 1.3 open_conn if (! $reuse_conn);
88 dpavlin 1.1 try_expn($_);
89 dpavlin 1.3 close_conn if (! $reuse_conn);
90 dpavlin 1.1 }
91    
92 dpavlin 1.3 close_conn if ($reuse_conn);
93 dpavlin 1.1 exit;

  ViewVC Help
Powered by ViewVC 1.1.26