/[sap_import]/mail2sap.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

Contents of /mail2sap.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Tue Feb 4 13:03:07 2003 UTC (16 years, 3 months ago) by dpavlin
Branch: MAIN
Changes since 1.7: +8 -3 lines
File MIME type: text/plain
fixes and improvements

1 #!/usr/bin/suidperl
2
3 # read e-mail from stdit (pipe from /etc/aliases) and call SAP rfc function
4 #
5 # 2002-11-18 Dobrica Pavlinusic <dpavlin@pliva.hr>
6
7 require 5.001;
8
9 use strict;
10 use vars qw($Msgno);
11 use SAP::Rfc;
12 use Digest::MD5 qw(md5_hex);
13 use MIME::Parser;
14 use XML::Simple;
15 use Data::Dumper;
16
17 # read configuration from xml file
18 my $config = XMLin();
19
20 # directory in which attachemnts will be left
21 my $outdir = $config->{outdir} || die "config: on <outdir> defined";
22 # temporary directory (ON SAME FILESYSTEM AS $outdir -- we use rename!)
23 # for extraction of *ALL* attachements
24 my $msgdir = $config->{msgdir} || die "config: no <msgdir> defined";
25 my $mntdir = $msgdir;
26 $msgdir .="/mime";
27 $msgdir .= "$$"; # append PID to make it unique
28 my $log = $config->{log} || die "config: no <log> defined";
29
30 # open log and redirect die to it...
31 open(LOG,">> $log") || warn "open log $log: $!";
32 local $SIG{__DIE__} = sub { print LOG $_[0] ; die $_[0] };
33
34 umask 022; # world readable
35
36
37 #------------------------------------------------------------
38 # dump_entity - dump an entity's file info
39 #------------------------------------------------------------
40 sub dump_entity {
41 my $ent = shift;
42 my @parts = $ent->parts;
43
44 if (@parts) { # multipart...
45 map { dump_entity($_) } @parts;
46 } else { # single part...
47 # print " Part: ", $ent->bodyhandle->path,
48 # " (", scalar($ent->head->mime_type), ")\n";
49 if ($ent->head->mime_type =~ m,text/plain,i) {
50 # open(I,$ent->bodyhandle->path) || die "$ent->bodyhandle->path: $!";
51 # while(<I>) { print LOG $_; }
52 # close(I);
53 unlink $ent->bodyhandle->path;
54 } else {
55 my $file=$ent->bodyhandle->path;
56 my $new=$file;
57 $new=~s/ +/_/g;
58 $new=~s/^.*\/([^\/]+)$/$1/g;
59 $new=~s/[^a-zA-Z._0-9]//g;
60
61 # never try to overwrite file
62 my $suffix = "";
63 while (-e "$outdir/$new$suffix") { $suffix++; }
64 $new .= $suffix;
65
66 rename $file,"$outdir/$new" || die "move $file -> $outdir/$new: $!";
67 my $prog = $0;
68 $prog =~ s/^.*\/([^\/])+$/$1/g;
69 print LOG scalar localtime," $prog $new\n";
70
71 # now, call SAP rfc
72
73 # init SAP rfc
74 #
75 my $rfc = new SAP::Rfc(
76 ASHOST => $config->{sap}->{ashost},
77 USER => $config->{sap}->{user},
78 PASSWD => $config->{sap}->{passwd},
79 LANG => $config->{sap}->{lang},
80 CLIENT => $config->{sap}->{client},
81 SYSNR => $config->{sap}->{sysnr},
82 TRACE => $config->{sap}->{trace}
83 ) || die "new: $!";
84
85 $rfc->is_connected || die "SAP rfc: not connected";
86
87 my $it = $rfc->discover($config->{sap}->{discover}) || die "discover: $!";
88
89 foreach my $p ($config->{sap}->{params}) {
90 foreach my $p_name (keys %{$p}) {
91 $it->$p_name($p->{$p_name});
92 }
93 }
94
95 $it->FILENAME( $new );
96
97 $rfc->callrfc( $it );
98
99 $rfc->close();
100 }
101 }
102 }
103
104
105 #------------------------------------------------------------
106 # main
107 #------------------------------------------------------------
108 sub main {
109 my $file;
110 my $entity;
111
112 chdir ($mntdir) || die "can't chdir to $mntdir: $!";
113 mkdir ($msgdir,0755) || die `id`."can't create $msgdir: $!";
114 die "problems with creation of directory $msgdir: $!" if (! -w $msgdir);
115
116 my $parser = new MIME::Parser;
117 ### $parser->parse_nested_messages('REPLACE');
118
119 $parser->output_dir($msgdir);
120
121 open FILE, "-" or die "couldn't open $file";
122 $entity = $parser->read(\*FILE) or
123 print STDERR "Couldn't parse MIME in $file; continuing...\n";
124 close FILE;
125
126 dump_entity($entity) if $entity;
127 ### $entity->dump_skeleton if $entity;
128
129 rmdir $msgdir || die "can't remove $msgdir: $!";
130
131 1;
132 }
133
134 exit (&main ? 0 : -1);
135 #------------------------------------------------------------
136 1;
137

  ViewVC Help
Powered by ViewVC 1.1.26