CHUNKING: fix transport crash on temp-reject of pipelined non-first chunk
[exim.git] / src / src / exim_checkaccess.src
1 #! /bin/sh
2
3 # Copyright (c) University of Cambridge, 1995 - 2007
4 # See the file NOTICE for conditions of use and distribution.
5
6 # Except when they appear in comments, the following placeholders in this
7 # source are replaced when it is turned into a runnable script:
8 #
9 # CONFIGURE_FILE_USE_NODE
10 # CONFIGURE_FILE
11 # BIN_DIRECTORY
12 # PERL_COMMAND
13
14 # PROCESSED_FLAG
15
16 # A shell+perl wrapper script to run an automated -bh test to check out
17 # ACLs for incoming addresses.
18
19 # Save the shell arguments because we are going to need the shell variables
20 # while sorting out the configuration file.
21
22 args="$@"
23
24 # See if this installation is using the esoteric "USE_NODE" feature of Exim,
25 # in which it uses the host's name as a suffix for the configuration file name.
26
27 if [ "CONFIGURE_FILE_USE_NODE" = "yes" ]; then
28   hostsuffix=.`uname -n`
29 fi
30
31 # Now find the configuration file name. This has got complicated because
32 # CONFIGURE_FILE may now be a list of files. The one that is used is the first
33 # one that exists. Mimic the code in readconf.c by testing first for the
34 # suffixed file in each case.
35
36 set `awk -F: '{ for (i = 1; i <= NF; i++) print $i }' <<End
37 CONFIGURE_FILE
38 End
39 `
40 while [ "$config" = "" -a $# -gt 0 ] ; do
41   if [ -f "$1$hostsuffix" ] ; then
42     config="$1$hostsuffix"
43   elif [ -f "$1" ] ; then
44     config="$1"
45   fi
46   shift
47 done
48
49 # Search for an exim_path setting in the configure file; otherwise use the bin
50 # directory. BEWARE: a tab character is needed in the command below. It has had
51 # a nasty tendency to get lost in the past. Use a variable to hold a space and
52 # a tab to keep the tab in one place.
53
54 exim_path=`perl -ne 'chop;if (/^\s*exim_path\s*=\s*(.*)/){print "$1\n";last;}' $config`
55 if test "$exim_path" = ""; then exim_path=BIN_DIRECTORY/exim; fi
56
57
58 #########################################################################
59
60
61 # Now run the perl script, passing in the Exim path and the arguments given
62 # to the overall script.
63
64 PERL_COMMAND - $exim_path $args <<'End'
65
66 use FileHandle;
67 use IPC::Open2;
68
69 if (scalar(@ARGV) < 3)
70   {
71   print "Usage: exim_checkaccess <IP address> <email address> [exim options]\n";
72   exit(1);
73   }
74
75 $exim_path = $ARGV[0];          # Set up by the calling shell script
76 $host      = $ARGV[1];          # Mandatory original first argument
77 $recipient = $ARGV[2];          # Mandatory original second argument
78
79 $c4 = qr/2 (?:[0-4]\d | 5[0-5]) | 1\d\d | \d{1,2}/x;  # IPv4 component
80 $a4 = qr/^$c4\.$c4\.$c4\.$c4$/;                       # IPv4 address
81
82 $c6 = qr/[0-9a-f]{1,4}/i;                             # IPv6 component
83
84 # Split the various formats of IPv6 addresses into several cases. I don't
85 # think I can graft regex that matches all of them without using alternatives.
86
87 # 1. Starts with :: followed by up to 7 components
88
89 $a6_0 = qr/^::(?:$c6:){0,6}$c6$/x;
90
91 # 2. 8 non-empty components
92
93 $a6_1 = qr/^(?:$c6:){7}$c6$/x;
94
95 # 3. This is the cunning one. Up to 7 components, one (and only one) of which
96 # can be empty. We use 0 to cause a failure when we've already matched
97 # an empty component and may be hitting other. This has to fail, because we
98 # know we've just failed to match a component. We also do a final check to
99 # ensure that there has been an empty component.
100
101 $a6_2 = qr/^(?: (?: $c6 | (?(1)0 | () ) ) : ){1,7}$c6 $ (?(1)|.)/x;
102
103 if ($host !~ /$a4 | $a6_0 | $a6_1 | $a6_2/x)
104   {
105   print "** Invalid IP address \"$host\"\n";
106   print "Usage: exim_checkaccess <IP address> <email address> [exim options]\n";
107   exit(1);
108   }
109
110 # Build any remaining original arguments into a string for passing over
111 # as Exim options.
112
113 $opt = "";
114 for ($i = 3; $i < scalar(@ARGV); $i++) { $opt .= "$ARGV[$i] "; }
115
116 # If the string contains "-f xxxx", extract that as the sender. Otherwise
117 # the sender is <>.
118
119 $sender    = "";
120 if ($opt =~ /(?:^|\s)-f\s+(\S+|"[^"]*")/)
121   {
122   $sender = $1;
123   $opt = $` . $';
124   }
125
126 # Run a -bh test in Exim, passing the test data
127
128 $pid = open2(*IN, *OUT, "$exim_path -bh $host $opt 2>/dev/null");
129 print OUT "HELO [$host]\r\n";
130 print OUT "MAIL FROM:<$sender>\r\n";
131 print OUT "RCPT TO:<$recipient>\r\n";
132 print OUT "QUIT\r\n";
133 close OUT;
134
135 # Read the output, ignoring anything but the SMTP response to the RCPT
136 # command.
137
138 $count = 0;
139 $reply = "";
140
141 while (<IN>)
142   {
143   next if !/^\d\d\d/;
144   $reply .= $_;
145   next if /^\d\d\d\-/;
146
147   if (++$count != 4)
148     {
149     $reply = "";
150     next;
151     }
152
153   # We have the response we want. Interpret it.
154
155   if ($reply =~ /^2\d\d/)
156     {
157     print "Accepted\n";
158     }
159   else
160     {
161     print "Rejected:\n";
162     $reply =~ s/\n(.)/\n  $1/g;
163     print "  $reply";
164     }
165   last;
166   }
167
168 # Reap the child process
169
170 waitpid $pid, 0;
171
172 End