* curl-shim.c (curl_easy_perform): Fix compile warning.
[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 $Getopt::Std::STANDARD_HELP_VERSION=1;
24 $sendmail="@SENDMAIL@ -t";
25
26 ###
27
28 sub VERSION_MESSAGE ()
29 {
30     print STDOUT "gpgkeys_mailto (GnuPG) 1.3.91-cvs\n";
31 }
32
33 sub HELP_MESSAGE ()
34 {
35     print STDOUT <<EOT
36
37 --help     Print this help
38 --version  Print the version
39 -o FILE    Write output to FILE
40 EOT
41 }
42
43
44
45 getopts('o:');
46
47 if(defined($opt_o))
48 {
49     open(STDOUT,">$opt_o") || die "Can't open output file $opt_o\n";
50 }
51
52 if(@ARGV)
53 {
54     open(STDIN,$ARGV[0]) || die "Can't open input file $ARGV[0]\n";
55 }
56
57 ($login,$name)=(getpwuid($<))[0,6];
58
59 $from="$name <$login>";
60
61 while(<STDIN>)
62 {
63     last if($_ eq "\n");
64
65     if(/^COMMAND (\S+)/)
66     {
67         $command=$1;
68     }
69
70     if(/^OPAQUE (\S+)/)
71     {
72         $address=$1;
73     }
74
75     if(/^PROGRAM (\S+)/)
76     {
77         $program=$1;
78     }
79
80     if(/^OPTION (\S+)/)
81     {
82         if($1=~/^verbose$/i)
83         {
84             $verbose++;
85         }
86         elsif($1=~/^no-verbose$/i)
87         {
88             $verbose--;
89         }
90     }
91 }
92
93 $program="(unknown)" if(!defined($program));
94
95 if(!defined($address))
96 {
97     print STDERR "gpgkeys: no address provided\n";
98     exit(1);
99 }
100
101 # decode $address
102
103 ($address,$args)=split(/\?/,$address);
104
105 if(defined($args))
106 {
107     @pairs = split(/&/, $args);
108     foreach $pair (@pairs)
109     {
110         ($hdr, $val) = split(/=/, $pair);
111         $hdr =~ tr/+/ /;
112         $hdr =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
113         $val =~ tr/+/ /;
114         $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
115 # we only handle "from" right now
116         if($hdr=~/^from$/i)
117         {
118             $from=$val;
119             last;
120         }
121     }
122 }
123
124 while(<STDIN>)
125 {
126     last if($_ eq "\n");
127
128     chomp;
129
130     push(@keys,$_);
131 }
132
133 # Send response
134
135 print "VERSION 1\n";
136 print "OPTION OUTOFBAND\n\n";
137
138 # Email keyservers get and search the same way
139
140 if($command=~/get/i || $command=~/search/i)
141 {
142     if($command=~/search/i)
143     {
144         print "COUNT 0\n";
145     }
146
147     foreach $key (@keys)
148     {
149         open(MAIL,"|$sendmail") || die "ERROR: Can't open $sendmail\n";
150         print MAIL "From: $from\n";
151         print MAIL "To: $address\n";
152         if($command=~/get/i)
153         {
154             # mail keyservers don't like long-form keyids
155
156             if(substr($key,0,2) eq "0x")
157             {
158                 $key=substr($key,2);
159             }
160
161             if(length($key)>8)
162             {
163                 $key=substr($key,-8);
164             }
165
166             print MAIL "Subject: GET 0x$key\n\n";
167         }
168         else
169         {
170             print MAIL "Subject: GET $key\n\n";
171         }
172         print MAIL "GnuPG $program email keyserver request\n";
173         close(MAIL);
174
175         # Tell GnuPG not to expect a key
176         print "KEY $key OUTOFBAND\n";
177
178         if($verbose)
179         {
180             print STDERR "gpgkeys: key $key requested from $address\n";
181         }
182     }
183 }
184
185 if($command=~/send/i)
186 {
187     while(!eof(STDIN))
188     {
189         open(MAIL,"|$sendmail") || die "ERROR: Can't open $sendmail\n";
190         print MAIL "From: $name <$login>\n";
191         print MAIL "To: $address\n";
192         print MAIL "Subject: ADD\n\n";
193
194         while(<STDIN>)
195         {
196             if(/^KEY (\S+) BEGIN$/)
197             {
198                 $key=$1;
199                 last;
200             }
201         }
202
203         while(<STDIN>)
204         {
205             if(/^KEY \S+ END$/)
206             {
207                 last;
208             }
209
210             print MAIL;
211         }
212
213         close(MAIL);
214
215         if($verbose)
216         {
217             print STDERR "gpgkeys: key $key sent to $address\n";
218         }
219     }
220 }
221
222
223 # Local Variables: 
224 # mode:perl
225 # End: