1#!/usr/local/bin/perl
2
3#
4# dbformmail
5# Copyright (C) 1997-1998 by John Heidemann <johnh@isi.edu>
6# $Id: dbformmail,v 1.14 2003/05/23 04:17:15 johnh Exp $
7#
8# This program is distributed under terms of the GNU general
9# public license, version 2.  See the file COPYING
10# in $dblibdir for details.
11#
12sub usage {
13    print <<REALEND;
14usage: $0 [-ds] form
15
16Read a ``form mail'' message from a file,
17filling in underscore-preeded column-names with data.
18Produces a shell script which will send each message through sendmail.
19
20Do not use this program for evil or I will have to come over
21and have words with you.
22
23Options:
24    -s write a script to send the mail (the default)
25    -S send the mail directly (not currently supported)
26    -m MECHANISM   select the mail-sending mechanism (Mail [default]
27		    or sendmail)
28    -d debugging mode
29
30Sample input:
31#h account passwd uid gid fullname homedir shell
32johnh * 2274 134 John_Heidemann /home/johnh /bin/bash
33greg * 2275 134 Greg_Johnson /home/greg /bin/bash
34root * 0 0 Root /root /bin/bash
35# this is a simple database
36
37Sample form (in the file form.txt):
38    To: _account
39    From: the sysadmin <root>
40    Subject: time to change your password
41
42    Please change your password regularly.
43
44
45Sample command:
46cat DATA/passwd.jdb | dbformmail form.txt
47
48Sample output:
49#!/bin/sh
50sendmail 'johnh' <<'END'
51To: johnh
52From: the sysadmin <root>
53Subject: time to change your password
54
55Please change your password regularly.
56
57END
58sendmail 'greg' <<'END'
59(etc.)
60
61REALEND
62    #';   hack for font-lock mode
63    exit 1;
64}
65
66BEGIN {
67    $dblibdir = "/home/johnh/BIN/DB";
68    push(@INC, $dblibdir);
69}
70require "$dblibdir/dblib.pl";
71use DbGetopt;
72
73my(@orig_argv) = @ARGV;
74my($prog) = &progname;
75my($write_script) = 1;
76my($debug) = 0;
77my($mechanism) = 'Mail';
78my($dbopts) = new DbGetopt("dm:s?", \@ARGV);
79my($ch);
80while ($dbopts->getopt) {
81    $ch = $dbopts->opt;
82    if ($ch eq 's') {
83	$write_script = 1;
84    } elsif ($ch eq 'd') {
85	$debug++;
86    } elsif ($ch eq 'm') {
87	$mechanism = $dbopts->optarg;
88    } else {
89	&usage;
90    };
91};
92&usage if ($#ARGV != 0);
93if (!($mechanism eq 'Mail' || $mechanism eq 'sendmail')) {
94    warn "$0: unknown mail mechanism $mechanism.\n";
95    &usage;
96};
97my($form_file) = $ARGV[0];
98die ("$prog: non- -s verison not currently implemented.\n") if (!$write_script);
99
100#
101# Read the form.
102#
103open(FORM, "<$form_file") || die("$prog: cannot open $form_file.\n");
104@form = ();
105while (<FORM>) {
106    s/\@/\\\@/;   # quote @'s
107    push(@form, $_);
108}
109close FORM;
110die ("$prog: no To: line in form.\n")
111    if (!grep(/^To:/i, @form));
112
113
114#
115# Do it.
116#
117&readprocess_header;
118# Generate the code.
119my($code) = codify("<<END;\n" . join("", @form) . "END\n");
120
121print $code if ($debug);
122
123print "#!/bin/sh\n";
124
125while (<STDIN>) {
126    if (&is_comment) {
127	push(@comments, $_);
128	next;
129    };
130    &split_cols;
131    $result = eval $code;   $@ && die ("$prog: internal eval error ``$@''.\n");
132
133    # This is not a very elegant to extract the destination.  :-<
134    my(@field_names) = qw(to cc subject);
135    my($field_regexp) = '(' . join("|", @field_names) . ')';
136    my(%fields);
137    my($in_body) = undef;
138    my $result_body = '';
139    foreach (split(/\n/, $result)) {
140	if ($in_body) {
141	    $result_body .= "$_\n";
142	    next;
143	};
144	if (/^\s*$/) {
145	    # blank line terminates header
146	    $in_body = 1;
147	    next;
148	};
149	if (/^$field_regexp:\s*(.*)$/i) {
150	    my($key, $value) = (lc($1), $2);
151	    die "$0: duplicate fields not supported, field: $key.\n"
152		if (defined($fields{$key}));
153	    $fields{$key} = $value;
154	};
155    };
156    die ("$prog: to missing.\n") if (!defined($fields{'to'}));
157
158    # Quote single quotes in $to.
159    foreach (keys %fields) {
160	$fields{$_} =~ s/\'/\'\\\'\'/g;
161    };
162
163    if ($mechanism eq 'sendmail') {
164        print "sendmail '" . $fields{"to"} . "' <<'END'\n$result\nEND\n\n";
165    } elsif ($mechanism eq 'Mail') {
166	my $cc_arg = (defined($fields{"cc"}) ? "-c '" . $fields{"cc"} . "' " : "");
167	my $subject_arg = (defined($fields{"subject"}) ? "-s '" . $fields{"subject"} . "' " : "");
168	print "Mail $subject_arg $cc_arg '" . $fields{"to"} . "' <<'END'\n$result_body\nEND\n\n";
169    } else {
170	die "$0: unknown mechanism $mechanism.\n";
171    };
172};
173
174print "\n" . join("", @comments) . "# | $prog " . join(" ", @orig_argv) . "\n";
175exit 0;
176