viewvc.cgi/sap_import/mail2sap.pl

#!/usr/bin/suidperl 

# read e-mail from stdit (pipe from /etc/aliases) and call SAP rfc function
#
# 2002-11-18 Dobrica Pavlinusic <dpavlin@pliva.hr>

require 5.001;

use strict;
use vars qw($Msgno);
use SAP::Rfc;
use Digest::MD5 qw(md5_hex);
use MIME::Parser;
use XML::Simple;
use Data::Dumper;

# read configuration from xml file
my $config = XMLin();

# directory in which attachemnts will be left
my $outdir = $config->{outdir} || die "config: on <outdir> defined";
# temporary directory (ON SAME FILESYSTEM AS $outdir -- we use rename!)
# for extraction of *ALL* attachements
my $msgdir = $config->{msgdir} || die "config: no <msgdir> defined";
my $mntdir = $msgdir;
$msgdir .="/mime";
$msgdir .= "$$";        # append PID to make it unique
my $log = $config->{log} || die "config: no <log> defined";

# open log and redirect die to it...
open(LOG,">> $log") || warn "open log $log: $!";
local $SIG{__DIE__} = sub { print LOG scalar localtime,$_[0] ; die $_[0] };

umask 022;      # world readable


#------------------------------------------------------------
# dump_entity - dump an entity's file info
#------------------------------------------------------------
sub dump_entity {
    my $ent = shift;
    my @parts = $ent->parts;

    if (@parts) {       # multipart...
        map { dump_entity($_) } @parts;
    } else {            # single part...
        print LOG scalar localtime," Att: ", $ent->bodyhandle->path, " (", scalar($ent->head->mime_type), ")\n";
        if ($ent->head->mime_type =~ m,text/plain,i && $ent->bodyhandle->path !~ m/(Orders|edi)/i) {
#               open(I,$ent->bodyhandle->path) || die "$ent->bodyhandle->path: $!";
#               while(<I>) { print LOG $_; }
#               close(I);
                unlink $ent->bodyhandle->path;
        } else {
                my $file=$ent->bodyhandle->path;
                my $new=$file;
                $new=~s/ +/_/g;
                $new=~s/^.*\/([^\/]+)$/$1/g;
                $new=~s/[^a-zA-Z._0-9]//g;

                # never try to overwrite file
                my $suffix = "";
                while (-e "$outdir/$new$suffix") { $suffix++; }
                $new .= $suffix;

                rename $file,"$outdir/$new" || die "move $file -> $outdir/$new: $!";

                # now, call SAP rfc

                # init SAP rfc
                #
                my $rfc = new SAP::Rfc(
                        ASHOST  => $config->{sap}->{ashost},
                        USER    => $config->{sap}->{user}, 
                        PASSWD  => $config->{sap}->{passwd}, 
                        LANG    => $config->{sap}->{lang},
                        CLIENT  => $config->{sap}->{client},
                        SYSNR   => $config->{sap}->{sysnr},
                        TRACE   => $config->{sap}->{trace}
                        ) || die "new: $!";

                $rfc->is_connected || die "SAP rfc: not connected";

                my $it = $rfc->discover($config->{sap}->{discover}) || die "discover: $!";

                foreach my $p ($config->{sap}->{params}) {
                        foreach my $p_name (keys %{$p}) {
                                $it->$p_name($p->{$p_name});
                        }
                }

                $it->FILENAME( $new );

                print LOG scalar localtime," RFC: $new\n";
                $rfc->callrfc( $it );

                $rfc->close();
        }
    }
}


#------------------------------------------------------------
# main
#------------------------------------------------------------
sub main {
        my $file;
        my $entity;
        
        chdir ($mntdir) || die "can't chdir to $mntdir: $!";
        mkdir ($msgdir,0755) || die `id`."can't create $msgdir: $!";
        die "problems with creation of directory $msgdir: $!" if (! -w $msgdir);

        my $parser = new MIME::Parser;
        ### $parser->parse_nested_messages('REPLACE');
    
        $parser->output_dir($msgdir);
    
        open FILE, "-" or die "couldn't open $file";
        $entity = $parser->read(\*FILE) or 
            print STDERR "Couldn't parse MIME in $file; continuing...\n";
        close FILE;

        dump_entity($entity) if $entity;
        ### $entity->dump_skeleton if $entity;

        rmdir $msgdir || die "can't remove $msgdir: $!";

        1;
}

exit (&main ? 0 : -1);
#------------------------------------------------------------
1;

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.10	local $SIG{__DIE__} = sub { print LOG scalar localtime,$_[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	dpavlin	1.11	print LOG scalar localtime," Att: ", $ent->bodyhandle->path, " (", scalar($ent->head->mime_type), ")\n";
48			if ($ent->head->mime_type =~ m,text/plain,i && $ent->bodyhandle->path !~ m/(Orders\|edi)/i) {
49	dpavlin	1.1	# open(I,$ent->bodyhandle->path) \|\| die "$ent->bodyhandle->path: $!";
50			# while(<I>) { print LOG $_; }
51			# close(I);
52			unlink $ent->bodyhandle->path;
53			} else {
54			my $file=$ent->bodyhandle->path;
55			my $new=$file;
56			$new=~s/ +/_/g;
57			$new=~s/^.*\/([^\/]+)$/$1/g;
58			$new=~s/[^a-zA-Z._0-9]//g;
59	dpavlin	1.2
60			# never try to overwrite file
61			my $suffix = "";
62			while (-e "$outdir/$new$suffix") { $suffix++; }
63			$new .= $suffix;
64
65	dpavlin	1.1	rename $file,"$outdir/$new" \|\| die "move $file -> $outdir/$new: $!";
66
67			# now, call SAP rfc
68
69	dpavlin	1.4	# init SAP rfc
70			#
71			my $rfc = new SAP::Rfc(
72			ASHOST => $config->{sap}->{ashost},
73			USER => $config->{sap}->{user},
74			PASSWD => $config->{sap}->{passwd},
75			LANG => $config->{sap}->{lang},
76			CLIENT => $config->{sap}->{client},
77			SYSNR => $config->{sap}->{sysnr},
78			TRACE => $config->{sap}->{trace}
79			) \|\| die "new: $!";
80
81			$rfc->is_connected \|\| die "SAP rfc: not connected";
82
83	dpavlin	1.6	my $it = $rfc->discover($config->{sap}->{discover}) \|\| die "discover: $!";
84	dpavlin	1.2
85	dpavlin	1.7	foreach my $p ($config->{sap}->{params}) {
86			foreach my $p_name (keys %{$p}) {
87			$it->$p_name($p->{$p_name});
88			}
89			}
90
91	dpavlin	1.2	$it->FILENAME( $new );
92
93	dpavlin	1.11	print LOG scalar localtime," RFC: $new\n";
94	dpavlin	1.1	$rfc->callrfc( $it );
95	dpavlin	1.4
96			$rfc->close();
97	dpavlin	1.1	}
98			}
99			}
100
101
102			#------------------------------------------------------------
103			# main
104			#------------------------------------------------------------
105			sub main {
106			my $file;
107			my $entity;
108	dpavlin	1.8
109			chdir ($mntdir) \|\| die "can't chdir to $mntdir: $!";
110			mkdir ($msgdir,0755) \|\| die `id`."can't create $msgdir: $!";
111	dpavlin	1.1	die "problems with creation of directory $msgdir: $!" if (! -w $msgdir);
112
113			my $parser = new MIME::Parser;
114			### $parser->parse_nested_messages('REPLACE');
115
116			$parser->output_dir($msgdir);
117
118			open FILE, "-" or die "couldn't open $file";
119			$entity = $parser->read(\*FILE) or
120			print STDERR "Couldn't parse MIME in $file; continuing...\n";
121			close FILE;
122
123			dump_entity($entity) if $entity;
124			### $entity->dump_skeleton if $entity;
125
126			rmdir $msgdir \|\| die "can't remove $msgdir: $!";
127
128			1;
129			}
130
131			exit (&main ? 0 : -1);
132			#------------------------------------------------------------
133			1;
134