/[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

Annotation of /mail2sap.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (hide annotations)
Mon Mar 10 15:49:01 2003 UTC (16 years, 5 months ago) by dpavlin
Branch: MAIN
Changes since 1.8: +1 -1 lines
File MIME type: text/plain
better dates in logs

1 dpavlin 1.7 #!/usr/bin/suidperl
2 dpavlin 1.1
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 dpavlin 1.2 use SAP::Rfc;
12 dpavlin 1.1 use Digest::MD5 qw(md5_hex);
13     use MIME::Parser;
14 dpavlin 1.3 use XML::Simple;
15     use Data::Dumper;
16 dpavlin 1.1
17 dpavlin 1.3 # read configuration from xml file
18     my $config = XMLin();
19 dpavlin 1.1
20     # directory in which attachemnts will be left
21 dpavlin 1.3 my $outdir = $config->{outdir} || die "config: on <outdir> defined";
22 dpavlin 1.1 # temporary directory (ON SAME FILESYSTEM AS $outdir -- we use rename!)
23     # for extraction of *ALL* attachements
24 dpavlin 1.3 my $msgdir = $config->{msgdir} || die "config: no <msgdir> defined";
25 dpavlin 1.8 my $mntdir = $msgdir;
26     $msgdir .="/mime";
27 dpavlin 1.3 $msgdir .= "$$"; # append PID to make it unique
28     my $log = $config->{log} || die "config: no <log> defined";
29 dpavlin 1.1
30 dpavlin 1.2 # open log and redirect die to it...
31     open(LOG,">> $log") || warn "open log $log: $!";
32 dpavlin 1.9 local $SIG{__DIE__} = sub { print scalar localtime LOG $_[0] ; die $_[0] };
33 dpavlin 1.2
34 dpavlin 1.1 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 dpavlin 1.2
61     # never try to overwrite file
62     my $suffix = "";
63     while (-e "$outdir/$new$suffix") { $suffix++; }
64     $new .= $suffix;
65    
66 dpavlin 1.1 rename $file,"$outdir/$new" || die "move $file -> $outdir/$new: $!";
67 dpavlin 1.8 my $prog = $0;
68     $prog =~ s/^.*\/([^\/])+$/$1/g;
69     print LOG scalar localtime," $prog $new\n";
70 dpavlin 1.1
71     # now, call SAP rfc
72    
73 dpavlin 1.4 # 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 dpavlin 1.6 my $it = $rfc->discover($config->{sap}->{discover}) || die "discover: $!";
88 dpavlin 1.2
89 dpavlin 1.7 foreach my $p ($config->{sap}->{params}) {
90     foreach my $p_name (keys %{$p}) {
91     $it->$p_name($p->{$p_name});
92     }
93     }
94    
95 dpavlin 1.2 $it->FILENAME( $new );
96    
97 dpavlin 1.1 $rfc->callrfc( $it );
98 dpavlin 1.4
99     $rfc->close();
100 dpavlin 1.1 }
101     }
102     }
103    
104    
105     #------------------------------------------------------------
106     # main
107     #------------------------------------------------------------
108     sub main {
109     my $file;
110     my $entity;
111 dpavlin 1.8
112     chdir ($mntdir) || die "can't chdir to $mntdir: $!";
113     mkdir ($msgdir,0755) || die `id`."can't create $msgdir: $!";
114 dpavlin 1.1 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