* distfiles, _regex.h: Add _regex.h from glibc 2.3.1.
[gnupg.git] / keyserver / gpgkeys_mailto.in
1 #!@PERL@ -w
2
3 # gpgkeys_mailto - talk to a email keyserver
4 # Copyright (C) 2001, 2002 Free Software Foundation, Inc.
5 #
6 # This file is part of GnuPG.
7 #
8 # GnuPG is free software; you can redistribute it and/or modify
9 # it under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 2 of the License, or
11 # (at your option) any later version.
12 #
13 # GnuPG is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 # GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software
20 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
21
22 use Getopt::Std;
23 $sendmail="@SENDMAIL@ -t";
24
25 ###
26
27 getopts('o:');
28
29 if(defined($opt_o))
30 {
31     open(STDOUT,">$opt_o") || die "Can't open output file $opt_o\n";
32 }
33
34 if(@ARGV)
35 {
36     open(STDIN,$ARGV[0]) || die "Can't open input file $ARGV[0]\n";
37 }
38
39 ($login,$name)=(getpwuid($<))[0,6];
40
41 $from="$name <$login>";
42
43 while(<STDIN>)
44 {
45     last if($_ eq "\n");
46
47     if(/^COMMAND (\w+)/)
48     {
49         $command=$1;
50     }
51
52     if(/^OPAQUE (\S+)/)
53     {
54         $address=$1;
55     }
56
57     if(/^PROGRAM (\S+)/)
58     {
59         $program=$1;
60     }
61
62     if(/^OPTION (\w+)/)
63     {
64         if($1=~/^verbose$/i)
65         {
66             $verbose++;
67         }
68         elsif($1=~/^no-verbose$/i)
69         {
70             $verbose--;
71         }
72     }
73 }
74
75 $program="(unknown)" if(!defined($program));
76
77 if(!defined($address))
78 {
79     print STDERR "gpgkeys: no address provided\n";
80     exit(1);
81 }
82
83 # decode $address
84
85 ($address,$args)=split(/\?/,$address);
86
87 if(defined($args))
88 {
89     @pairs = split(/&/, $args);
90     foreach $pair (@pairs)
91     {
92         ($hdr, $val) = split(/=/, $pair);
93         $hdr =~ tr/+/ /;
94         $hdr =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
95         $val =~ tr/+/ /;
96         $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
97 # we only handle "from" right now
98         if($hdr=~/^from$/i)
99         {
100             $from=$val;
101             last;
102         }
103     }
104 }
105
106 while(<STDIN>)
107 {
108     last if($_ eq "\n");
109
110     chomp;
111
112     push(@keys,$_);
113 }
114
115 # Send response
116
117 print "VERSION 0\n";
118 print "OPTION OUTOFBAND\n\n";
119
120 # Email keyservers get and search the same way
121
122 if($command=~/get/i || $command=~/search/i)
123 {
124     if($command=~/search/i)
125     {
126         print "COUNT 0\n";
127     }
128
129     foreach $key (@keys)
130     {
131         open(MAIL,"|$sendmail") || die "ERROR: Can't open $sendmail\n";
132         print MAIL "From: $from\n";
133         print MAIL "To: $address\n";
134         if($command=~/get/i)
135         {
136             # mail keyservers don't like long-form keyids
137
138             if(substr($key,0,2) eq "0x")
139             {
140                 $key=substr($key,2);
141             }
142
143             if(length($key)>8)
144             {
145                 $key=substr($key,-8);
146             }
147
148             print MAIL "Subject: GET 0x$key\n\n";
149         }
150         else
151         {
152             print MAIL "Subject: GET $key\n\n";
153         }
154         print MAIL "GnuPG $program email keyserver request\n";
155         close(MAIL);
156
157         # Tell GnuPG not to expect a key
158         print "KEY $key OUTOFBAND\n";
159
160         if($verbose)
161         {
162             print STDERR "gpgkeys: key $key requested from $address\n";
163         }
164     }
165 }
166
167 if($command=~/send/i)
168 {
169     while(!eof(STDIN))
170     {
171         open(MAIL,"|$sendmail") || die "ERROR: Can't open $sendmail\n";
172         print MAIL "From: $name <$login>\n";
173         print MAIL "To: $address\n";
174         print MAIL "Subject: ADD\n\n";
175
176         while(<STDIN>)
177         {
178             if(/^KEY (\w+) BEGIN$/)
179             {
180                 $key=$1;
181                 last;
182             }
183         }
184
185         while(<STDIN>)
186         {
187             if(/^KEY \w+ END$/)
188             {
189                 last;
190             }
191
192             print MAIL;
193         }
194
195         close(MAIL);
196
197         if($verbose)
198         {
199             print STDERR "gpgkeys: key $key sent to $address\n";
200         }
201     }
202 }