-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathyaica.pl
executable file
·325 lines (304 loc) · 12.3 KB
/
yaica.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
#!/usr/bin/perl
############################################################################
# Y A I C A #
# Yet Another Image Converter for Attachments #
# v0.1.1 #
# #
# Copyright (C) 2006 by Boyan Tabakov #
# #
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation; either version 2 of the License, or #
# (at your option) any later version. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with this program; if not, write to the #
# Free Software Foundation, Inc., #
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. #
############################################################################
############################################################################
#NOTE to all Bulgarian speaking users: #
#==========================================================================#
# #
#Regardless of the name of the product it is absolutely #
#inappropriate to attempt any BOILING, FRYING, BACKING, #
#or any other transformations that aim to result in a #
#tasty MEAL! Furthermore, the product IS CERTAINLY NOT #
#INFECTED WITH BIRD FLU! Just in case you were wondering... #
# #
############################################################################
use 5.6.0;
use strict;
use warnings;
use Email::MIME;
use Image::Magick;
sub usage(); # Prints the usage of the programme.
sub get_args(); # Processes the command line arguments.
sub read_cfg(); # Read configuration file.
sub verify_cfg(); # Validates the values of all parameters.
sub read_message(); # Read email message from standard input.
sub get_images($$); # ($msg, \@arr) loop through $msg (Email::MIME) and build list of parts, containing images, in @arr.
sub store_image($$); # ($img, $fname) save the image pointed by $img (Email::MIME) with filename $fname and propper extension for the format.
sub form_prefix($); # ($msg) form filename prefix from the headers of $msg (Email::MIME). Prefix is '<sender email>-<id>'.
sub yaica_error($); # Print error message and die painfully...
sub main();
our $version = "0.1.1";
# default config
our $cfg_file;
$^O eq 'MSWin32' and
$cfg_file = 'c:\Program Files\Yaica\yaica.conf' or
$cfg_file = '/usr/local/etc/yaica.conf';
our %cfg = (
'tiff_fax'=>0,
'dest_format'=>'jpeg',
'dest_dir'=>'.',
'jpeg_quality'=>80,
'ignore_convert'=>0,
'grayscale'=>0,
'copy'=>0,
'input_file'=>undef,
);
our %args = (
'c'=>\$cfg{'copy'},
'i'=>\$cfg{'ignore_convert'},
'g'=>\$cfg{'grayscale'},
'x'=>\$cfg{'tiff_fax'},
'f'=>\$cfg{'dest_format'},
'd'=>\$cfg{'dest_dir'},
'q'=>\$cfg{'jpeg_quality'},
'r'=>\$cfg{'input_file'}
);
our %yesno = ('yes', 1, 'no', 0); # just a helper
our $message_id = '<init>';
sub usage(){
print "Yet Another Image Converter for Attachments v$version\n",
"Expects e-mail message on stdin (see -r).\n",
"Usage: yaica [options]\n",
" -r [filename] - Read from specified file instead of standard input\n",
" -f [jpeg|tiff] - Set destination image format.\n",
" -d [dirname] - Set destination directory.\n",
" -q [n] - Set jpeg quality - 'n' must be [1, 100].\n",
" -g - Convert to grayscale image.\n",
" -x - Output tiff for faxing. Destination format must be 'tiff', ignores -g.\n",
" -i - Ignore all convertions if image is in correct format.\n",
" Note that this will result in EXACT duplicate\n",
" of the attached image and options -q, -g and -x are ignored.\n",
" This will speed up processing.\n",
" -c - Creates exact duplicate of the original image, regardless of\n",
" the source and destination formats. Ignores all other options except for -d.\n",
" This will speed up processing.\n",
"The flags g, x, i and c may be used with '+' to turn off the given option (e.g. yaica -g +c).\n",
"This is useful when you have the option set to 'yes' in the config file.\n";
exit 1;
# Help!... heeeelp!...
# Yes - that's right! yaica -h returns error code! You are not allowed to ask for help...
}
sub yaica_error($){
my $msg = shift;
$msg = $message_id."\nYaica Error: ".$msg;
die $msg;
}
sub get_args(){
# Seems ok, but who knows?
while (@ARGV){
my $val;
$_ = shift @ARGV;
SWITCH:{
/^-([fdqr])$/ && do{
$val = shift @ARGV;
${$args{$1}} = $val;
last SWITCH;
};
/^-([xigc]+)$/ && do{
my @opts = split //, $1;
foreach my $opt (@opts){
${$args{$opt}} = 1;
}
last SWITCH;
};
/^\+([xigc]+)$/ && do{
my @opts = split //, $1;
foreach my $opt (@opts){
${$args{$opt}} = 0;
}
last SWITCH;
};
/.*/ && usage();
};
}
}
sub read_cfg(){
open (CONF, "<", $cfg_file) or yaica_error "Can't read configuration file $cfg_file!\n";
# She loves me!
while($_ = <CONF>){
SWITCH:{
/^dest_format=(.*)/i && do{
$1 =~ /^(jpeg|tiff)$/i or yaica_error "Option 'dest_format' in configuration file has illegal value '$1'! Must be 'jpeg' or 'tiff'.\n";
$cfg{'dest_format'} = lc $1;
last SWITCH;
};
/^dest_dir=(.*)/i && do{
$cfg{'dest_dir'} = $1;
last SWITCH;
};
/^ignore_convert=(.*)/i && do{
$1 =~ /^(yes|no)/i or yaica_error "Option 'ignore_convert' in configuration file has illegal value '$1'! Must be 'yes' or 'no'.\n";
$cfg{'ignore_convert'} = $yesno{$1};
last SWITCH;
};
/^copy=(.*)/i && do{
$1 =~ /^(yes|no)/i or yaica_error "Option 'copy' in configuration file has illegal value '$1'! Must be 'yes' or 'no'.\n";
$cfg{'copy'} = $yesno{$1};
last SWITCH;
};
/^grayscale=(.*)/i && do{
$1 =~ /^(yes|no)/i or yaica_error "Option 'grayscale' in configuration file has illegal value '$1'! Must be 'yes' or 'no'.\n";
$cfg{'grayscale'} = $yesno{$1};
last SWITCH;
};
/^jpeg_quality=(.*)/i && do{
$1 =~ /^(\d{1,3})/ or yaica_error "Option 'jpeg_quality' in configuration file has illegal value '$1'! Must be [1, 100].\n";
$cfg{'jpeg_quality'} = $1;
last SWITCH;
};
/^tiff_fax=(.*)/i && do{
$1 =~ /^(yes|no)/i or yaica_error "Option 'tiff_fax' in configuration file has illegal value '$1'! Must be 'yes' or 'no'.\n";
$cfg{'tiff_fax'} = $yesno{$1};
last SWITCH;
};
/^(\[.*\])|#.*|^$/ && last SWITCH;
# Empty lines, lines starting with # and section titles ([section]) are ignored!
# In case you can't tell this from the line above:) I couldn't! Well - the second time...
/^(\w*)=(.*)/ && do{
# If we get here we have a nice looking line but a non-recognized option. Poor we...
yaica_error "Bad option '$1' in configuration file!\n";
};
/^(.*)/ && do{
# Too bad... Someone was sleeping while typing...
yaica_error "Bad syntax in configuration file: '$1'!\n";
};
}
}
close CONF;
}
sub verify_cfg(){
# Did you spell it TiFf or tiFF or tiff? Well - it doesn't matter...
$cfg{'dest_format'} = lc $cfg{'dest_format'};
$cfg{'dest_format'} =~ /^(jpeg|tiff)$/ or yaica_error "Bad output format '$cfg{dest_format}'! Must be 'jpeg' or 'tiff'.\n";
#See if the directory exists. At some point I may add code to create the target directory, but who knows?
$cfg{'dest_dir'} = glob($cfg{'dest_dir'});
-d $cfg{'dest_dir'} or yaica_error "$cfg{'dest_dir'} is not a directory!\n";
# Add a nice little ending slash if the poor name lacks one...
$cfg{'dest_dir'} .= '/' if not $cfg{'dest_dir'} =~ /\/$/;
# No log(e.pi/2) quality allowed - sorry...
$cfg{'jpeg_quality'} = int $cfg{'jpeg_quality'};
if ($cfg{'jpeg_quality'} <= 0 || $cfg{'jpeg_quality'} > 100){
yaica_error "Jpeg quality '$cfg{jpeg_quality}' is invalid! Must be [1, 100].\n";
}
}
sub read_message(){
# See if we need to read a file or STDIN...
if (defined $cfg{'input_file'}){
close STDIN;
open STDIN, '<', $cfg{'input_file'} or yaica_error "Could not read from file '$cfg{input_file}'!\n";
}
# It is a plane! No, it is a train!, No, it is a SPACESHIP!
# Errr... and yet - not even a spaceship...
my $message = join "", <STDIN> or yaica_error "Could not read from standard input!\n";
return \$message;
# <=> <=> <=>
# But still, they come...
}
our $match = qr/(image\/(jpeg|pjpeg|tiff|gif|png|bmp|x-bmp))/o;
sub get_images($$){
my $cur = shift;
my $result = shift;
my @parts = $cur->parts;
if ($cur != $parts[0]){
# When we point back at ourselves this means we are up against the wall
# and have nowhere to go...
foreach (@parts){
get_images($_, $result);
}
}elsif ($cur->content_type =~ $match){
# Come on! Push the button, push the button!
push(@{$result}, $cur);
}
# Not that button!!!
}
sub store_image($$){
my $img = shift;
my $name = shift;
my $type = $img->content_type;
$type =~ $match;
$type = $2;
$type = 'bmp' if $type eq 'x-bmp'; # If there are more of these out there, I don't care!
$type = 'jpeg' if $type eq 'pjpeg';
if ($cfg{'copy'}){
# If we just duplicate the original files, we need the propper extensions...
$name .= '.jpg' if $type eq 'jpeg';
$name .= '.tif' if $type eq 'tiff';
$name .= '.'.$type if $type =~ /bmp|png|gif/;
}else{
# Well - we need them anyway:)
$cfg{'dest_format'} eq 'tiff' and $name .= '.tif' or $name .= '.jpg';
}
$name = $cfg{'dest_dir'}.$name;
if ($cfg{'copy'} || $type eq $cfg{'dest_format'} && $cfg{'ignore_convert'}){
# Do not do any convertions but just duplicate the attached image.
open (OUT, '>', $name) or yaica_error "Could not open file $name for writing!\n";
binmode OUT;
print OUT $img->body or yaica_error "Could not write to file $name!\n";
close OUT;
}else{
# Convert image format and/or apply other otions...
my $conv = new Image::Magick('magick'=>$type);
my $err;
$err = $conv->BlobToImage($img->body);
yaica_error "ImageMagick: $err\n" if $err =~ /Exception 4\d\d/;
my %params = ('filename'=>$name);
$params{'compression'} = 'JPEG';
$params{'quality'} = $cfg{'jpeg_quality'} if $cfg{'dest_format'} eq 'jpeg';
$params{'type'} = 'Grayscale' if $cfg{'grayscale'} && not $cfg{'tiff_fax'};
($params{'type'}, $params{'compression'}) = ('Bilevel', 'Fax') if $cfg{'dest_format'} eq 'tiff' && $cfg{'tiff_fax'};
$err = $conv->Write(%params);
yaica_error "ImageMagick: $err\n" if $err =~ /Exception 4\d\d/;
}
}
sub form_prefix($){
my $mail = shift;
my $from = $mail->header('From');
my $id = $mail->header('Message-Id');
$from =~ /(\w+((\.|-|\+)\w+)*)@(\w+(\.\w+)+)/;
$from = "$1".'@'."$4";
# Hmmm... which way would be better?
$id =~ s/\D//g if $^O eq 'MSWin32'; # Strip some nasty characters...
#$id = time if $id eq '';
return $from."-".$id;
}
sub main(){
read_cfg();
get_args();
verify_cfg();
my $mail = Email::MIME->new(${read_message()}) or yaica_error "Could not parse input!\n";
# It is really bad that we can't understand if the input is good or not quite...
# Do some guessing...
yaica_error "Bad input!\n" if $mail->content_type eq "" || $mail->header('From') eq "";
$message_id = $mail->header('Message-Id');
my @images;
get_images($mail, \@images);
my $pref = form_prefix($mail);
my $count = 0;
foreach(@images){
$count++;
store_image($_, $pref."-$count");
}
}
main::main();
# It is the End Of All Hope...