changes since 2.6.4
[fwknop.git] / perl / legacy / fwknop / fwknop_serv
1 #!/usr/bin/perl -w
2 #
3 ############################################################################
4 #
5 # File: fwknop_serv
6 #
7 # Purpose: To provide a minimal TCP server over which the fwknop client can
8 #          connect to send the SPA packet.  This breaks the traditional SPA
9 #          model of only using a single packet to transmit desired access
10 #          modifications, but if you want to send SPA packets over the Tor
11 #          network then this server is necessary.  A circuit through the
12 #          Tor network is built up over successive TCP connections, and
13 #          there is no way to send packets through Tor without an
14 #          established circuit.
15 #
16 # Author: Michael Rash (mbr@cipherdyne.org)
17 #
18 # Version: 1.9.12
19 #
20 # Copyright (C) 2004-2009 Michael Rash (mbr@cipherdyne.org)
21 #
22 # License (GNU Public License):
23 #
24 #    This program is distributed in the hope that it will be useful,
25 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
26 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
27 #    GNU General Public License for more details.
28 #
29 #    You should have received a copy of the GNU General Public License
30 #    along with this program; if not, write to the Free Software
31 #    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
32 #    USA
33 #
34 ############################################################################
35 #
36 # $Id: fwknop_serv 1533 2009-09-08 02:44:02Z mbr $
37 #
38
39 use IO::Socket;
40 use POSIX;
41 use Getopt::Long;
42 use strict;
43
44 my $config_file = '/etc/fwknop/fwknop.conf';
45 my %config = ();
46 my $debug  = 0;
47 my $lib_dir = '';
48 my $no_logs = 0;
49 my $print_help = 0;
50 my $no_locale  = 0;
51 my $print_version  = 0;
52 my $cmdline_locale = '';
53 my $override_config_str = '';
54 my $debug_to_file = '';
55 my $debug_include_pidname = 0;
56 my $IPPROTO_TCP  = 6;
57 my $IPPROTO_UDP  = 17;
58 my $SEND_MAIL = 1;
59 my $NO_MAIL   = 0;
60
61 my $version = '1.9.12';
62 my $revision_svn = '$Revision: 1359 $';
63 my $rev_num = '1';
64 ($rev_num) = $revision_svn =~ m|\$Rev.*:\s+(\S+)|;
65
66 ### run GetOpt() to get comand line args
67 &handle_command_line();
68
69 &usage(0) if $print_help;
70
71 &setup();
72
73 if ($config{'ENABLE_TCP_SERVER'} eq 'Y') {
74
75     &run_tcp_server();
76
77 } elsif ($config{'ENABLE_UDP_SERVER'} eq 'Y') {
78
79     &run_udp_server();
80
81 } else {
82     die "[*] Must have either ENABLE_TCP_SERVER or ENABLE_UDP_SERVER = Y";
83 }
84
85 exit 0;
86
87 #================================= end main ===============================
88
89 sub run_tcp_server() {
90
91     &logr('[+]', "listening on tcp port $config{'TCPSERV_PORT'}", $NO_MAIL);
92
93     my $server = IO::Socket::INET->new(
94         LocalPort => $config{'TCPSERV_PORT'},
95         Type   => SOCK_STREAM,
96         Reuse  => 1,
97         Listen => 5
98     ) or (&logr("[*] Could not listen on " .
99         "tcp/$config{'TCPSERV_PORT'}: $!", $SEND_MAIL) and die);
100
101     &drop_privs() unless $config{'AUTH_MODE'} eq 'SOCKET';
102
103     ### trivial loop; we just want the local TCP stack to accept connections;
104     ### fwknopd gets data from pcap anyway (unless AUTH_MODE == 'SOCKET', in
105     ### which case we send SPA packet data to fwknopd via a domain socket).
106     while (my $client = $server->accept()) {
107
108         $client->recv(my $candidate_spa_data, 1500, 0);
109
110         if ($config{'AUTH_MODE'} eq 'SOCKET') {
111             if (length($candidate_spa_data) >= $config{'MIN_SPA_PKT_LEN'}) {
112                 &send_spa_data_to_fwknopd_via_socket($candidate_spa_data,
113                     &IO::Socket::INET::peerhost($client), $IPPROTO_TCP);
114             }
115         }
116     }
117
118     close $server;
119
120     return;
121 }
122
123 sub run_udp_server() {
124
125     &logr('[+]', "listening on udp port $config{'TCPSERV_PORT'}", $NO_MAIL);
126
127     my $server = IO::Socket::INET->new(
128         LocalPort => $config{'UDPSERV_PORT'},
129         Proto  => 'udp',
130         Reuse  => 1,
131     ) or (&logr("[*] Could not listen on " .
132         "udp/$config{'UDPSERV_PORT'}: $!", $SEND_MAIL) and die);
133
134     &drop_privs() unless $config{'AUTH_MODE'} eq 'SOCKET';
135
136     while ($server->recv(my $candidate_spa_data, 1500, 0)) {
137         if ($config{'AUTH_MODE'} eq 'SOCKET') {
138             if (length($candidate_spa_data) >= $config{'MIN_SPA_PKT_LEN'}) {
139                 &send_spa_data_to_fwknopd_via_socket($candidate_spa_data,
140                     &IO::Socket::INET::peerhost($server), $IPPROTO_UDP);
141             }
142         }
143     }
144
145     close $server;
146
147     return;
148 }
149
150 sub send_spa_data_to_fwknopd_via_socket() {
151     my ($candidate_spa_data, $src_ip, $proto) = @_;
152
153     ### open domain socket with running fwknopd process
154     my $sock = IO::Socket::UNIX->new($config{'FWKNOP_SERV_SOCK'})
155         or die "[*] Could not acquire $config{'FWKNOP_SERV_SOCK'} ",
156         "socket: $!";
157     print $sock "$src_ip:$proto:$candidate_spa_data";
158     close $sock;
159
160     return;
161 }
162
163 sub drop_privs() {
164
165     &logr('[+]', "dropping privileges", $NO_MAIL);
166
167     my ($login, $pass, $uid, $gid) = getpwnam('nobody');
168     unless ($uid and $gid) {
169         warn "[-] Could not get UID and GID of user nobody";
170     }
171
172     ### drop privileges
173     if ($uid and $gid) {
174         POSIX::setuid($uid);
175         POSIX::setgid($gid);
176     }
177
178     return;
179 }
180
181 sub setup() {
182
183     ### import any override config files first
184     &import_override_configs() if $override_config_str;
185
186     ### import config
187     &import_config();
188
189     ### expand any embedded vars within config values
190     &expand_vars();
191
192     ### make sure all the vars we need are actually in the config file.
193     &required_vars();
194
195     ### import all necessary perl modules
196     &import_perl_modules();
197
198     ### validate config
199     &validate_config();
200
201     my $pid = fork();
202     exit 0 if $pid;
203     die "[*] $0: Couldn't fork: $!" unless defined $pid;
204     POSIX::setsid() or die "[*] $0: Can't start a new session: $!";
205
206     ### make sure there isn't another fwknop_serv process already running
207     &uniquepid();
208
209     ### write our pid out to disk
210     &writepid();
211
212     &handle_locale();
213
214     $debug = 1 if $debug_include_pidname and not $debug_to_file;
215
216     return;
217 }
218
219 sub handle_locale() {
220     if ($config{'LOCALE'} ne 'NONE') {
221         ### set LC_ALL env variable
222         $ENV{'LC_ALL'} = $config{'LOCALE'};
223     }
224     return;
225 }
226
227 sub validate_config() {
228     unless (&is_digit($config{'TCPSERV_PORT'})
229             and $config{'TCPSERV_PORT'} > 0
230             and $config{'TCPSERV_PORT'} < 65535) {
231         die "[*] TCPSERV_PORT must be between 1 and 65535";
232     }
233     unless (&is_digit($config{'UDPSERV_PORT'})
234             and $config{'UDPSERV_PORT'} > 0
235             and $config{'UDPSERV_PORT'} < 65535) {
236         die "[*] UDPSERV_PORT must be between 1 and 65535";
237     }
238     return;
239 }
240
241 sub is_digit() {
242     my $str = shift;
243     return 1 if $str =~ /^\d+$/;
244     return 0;
245 }
246
247 sub uniquepid() {
248     if (-e $config{'TCPSERV_PID_FILE'}) {
249         my $caller = $0;
250         open PIDFILE, "< $config{'TCPSERV_PID_FILE'}";
251         my $pid = <PIDFILE>;
252         close PIDFILE;
253         chomp $pid;
254         if (kill 0, $pid) {  # fwknop_serv is already running
255             die "[*] fwknop_serv (pid: $pid) is already running!  Exiting.\n";
256         }
257     }
258     return;
259 }
260
261 sub writepid() {
262     open P, "> $config{'TCPSERV_PID_FILE'}" or die "[*] Could not open ",
263         "$config{'TCPSERV_PID_FILE'}: $!";
264     print P $$, "\n";
265     close P;
266     chmod 0600, $config{'TCPSERV_PID_FILE'};
267     return;
268 }
269
270 sub import_override_configs() {
271     my @override_configs = split /,/, $override_config_str;
272     for my $file (@override_configs) {
273         die "[*] Override config file $file does not exist"
274             unless -e $file;
275         &import_config($file);
276     }
277     return;
278 }
279
280 sub import_config() {
281     open C, "< $config_file" or die "[*] Could not open ",
282         "config file $config_file: $!";
283     while (<C>) {
284         next if /^\s*#/;
285         if (/^\s*(\S+)\s+(\S+);/) {
286             $config{$1} = $2;
287         }
288     }
289     close C;
290     return;
291 }
292
293 ### write a message to syslog (leaves off $prefix, which assigns a
294 ### "type" to the message, when writing syslog; might add it later
295 sub logr() {
296     my ($prefix, $msg, $send_email) = @_;
297
298     return if $no_logs;
299
300     $msg = "fwknop_serv: $msg" if $debug_include_pidname;
301
302     if ($debug) {
303         print STDERR localtime() . " $prefix $msg\n";
304         return;
305     } elsif ($debug_to_file) {
306         open DBG, ">> $debug_to_file" or die $!;
307         print DBG localtime() . " $prefix $msg\n";
308         close DBG;
309         return;
310     }
311
312     ### see if we need to send an email
313     if ($send_email and $config{'ALERTING_METHODS'} !~ /noe?mail/i) {
314         &sendmail("$prefix $config{'HOSTNAME'} fwknop_serv: $msg");
315     }
316
317     return if $config{'ALERTING_METHODS'} =~ /no.?syslog/i;
318
319     ### this is an ugly hack to avoid the 'can't use string as subroutine'
320     ### error because of 'use strict'
321     if ($config{'FWSERV_SYSLOG_FACILITY'} =~ /LOG_LOCAL7/i) {
322         openlog($config{'FWSERV_SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL7());
323     } elsif ($config{'FWSERV_SYSLOG_FACILITY'} =~ /LOG_LOCAL6/i) {
324         openlog($config{'FWSERV_SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL6());
325     } elsif ($config{'FWSERV_SYSLOG_FACILITY'} =~ /LOG_LOCAL5/i) {
326         openlog($config{'FWSERV_SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL5());
327     } elsif ($config{'FWSERV_SYSLOG_FACILITY'} =~ /LOG_LOCAL4/i) {
328         openlog($config{'FWSERV_SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL4());
329     } elsif ($config{'FWSERV_SYSLOG_FACILITY'} =~ /LOG_LOCAL3/i) {
330         openlog($config{'FWSERV_SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL3());
331     } elsif ($config{'FWSERV_SYSLOG_FACILITY'} =~ /LOG_LOCAL2/i) {
332         openlog($config{'FWSERV_SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL2());
333     } elsif ($config{'FWSERV_SYSLOG_FACILITY'} =~ /LOG_LOCAL1/i) {
334         openlog($config{'FWSERV_SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL1());
335     } elsif ($config{'FWSERV_SYSLOG_FACILITY'} =~ /LOG_LOCAL0/i) {
336         openlog($config{'FWSERV_SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL0());
337     }
338
339     if ($config{'FWSERV_SYSLOG_PRIORITY'} =~ /LOG_INFO/i) {
340         syslog(&LOG_INFO(), $msg);
341     } elsif ($config{'FWSERV_SYSLOG_PRIORITY'} =~ /LOG_DEBUG/i) {
342         syslog(&LOG_DEBUG(), $msg);
343     } elsif ($config{'FWSERV_SYSLOG_PRIORITY'} =~ /LOG_NOTICE/i) {
344         syslog(&LOG_NOTICE(), $msg);
345     } elsif ($config{'FWSERV_SYSLOG_PRIORITY'} =~ /LOG_WARNING/i) {
346         syslog(&LOG_WARNING(), $msg);
347     } elsif ($config{'FWSERV_SYSLOG_PRIORITY'} =~ /LOG_ERR/i) {
348         syslog(&LOG_ERR(), $msg);
349     } elsif ($config{'FWSERV_SYSLOG_PRIORITY'} =~ /LOG_CRIT/i) {
350         syslog(&LOG_CRIT(), $msg);
351     } elsif ($config{'FWSERV_SYSLOG_PRIORITY'} =~ /LOG_ALERT/i) {
352         syslog(&LOG_ALERT(), $msg);
353     } elsif ($config{'FWSERV_SYSLOG_PRIORITY'} =~ /LOG_EMERG/i) {
354         syslog(&LOG_EMERG(), $msg);
355     }
356
357     closelog();
358
359     return;
360 }
361
362 sub expand_vars() {
363
364     my $has_sub_var = 1;
365     my $resolve_ctr = 0;
366
367     while ($has_sub_var) {
368         $resolve_ctr++;
369         $has_sub_var = 0;
370         if ($resolve_ctr >= 20) {
371             die "[*] Exceeded maximum variable resolution counter.";
372         }
373         for my $var (keys %config) {
374             my $val = $config{$var};
375             if ($val =~ m|\$(\w+)|) {
376                 my $sub_var = $1;
377                 die "[*] sub-ver $sub_var not allowed within same ",
378                     "variable $var" if $sub_var eq $var;
379                 if (defined $config{$sub_var}) {
380                     $val =~ s|\$$sub_var|$config{$sub_var}|;
381                     $config{$var} = $val;
382                 } else {
383                     die "[*] sub-var \"$sub_var\" not defined in ",
384                         "config for var: $var."
385                 }
386                 $has_sub_var = 1;
387             }
388         }
389     }
390     return;
391 }
392
393 sub handle_command_line() {
394
395     ### make Getopts case sensitive
396     Getopt::Long::Configure('no_ignore_case');
397     die "[*] Use --help for usage information.\n"  unless (GetOptions(
398         'config=s'  => \$config_file,
399         'debug'     => \$debug,
400         'Debug-to-file=s' => \$debug_to_file,
401         'Debug-include-pidname' => \$debug_include_pidname,
402         'no-logs'   => \$no_logs,
403         'Override-config=s' => \$override_config_str,
404         'LC_ALL=s'  => \$cmdline_locale,
405         'locale=s'  => \$cmdline_locale,
406         'no-LC_ALL' => \$no_locale,
407         'no-locale' => \$no_locale,
408         'Version'   => \$print_version,
409         'help'      => \$print_help
410     ));
411     return;
412 }
413
414 sub required_vars() {
415     for my $var qw(ENABLE_TCP_SERVER TCPSERV_PORT TCPSERV_PID_FILE
416             ENABLE_UDP_SERVER UDPSERV_PORT LOCALE MIN_SPA_PKT_LEN
417             FWSERV_SYSLOG_IDENTITY FWSERV_SYSLOG_FACILITY
418             FWSERV_SYSLOG_PRIORITY) {
419         die "[*] Required variable $var is not defined in $config_file"
420             unless defined $config{$var};
421     }
422     return;
423 }
424
425 sub import_perl_modules() {
426
427     my $mod_paths_ar = &get_mod_paths();
428
429     if ($#$mod_paths_ar > -1) {  ### /usr/lib/fwknop/ exists
430         push @$mod_paths_ar, @INC;
431         splice @INC, 0, $#$mod_paths_ar+1, @$mod_paths_ar;
432     }
433
434     if ($debug or $debug_to_file) {
435         &logr('[+]', "import_perl_modules INC array:", $NO_MAIL);
436         for (@INC) {
437             &logr('[+]', $_, $NO_MAIL);
438         }
439     }
440
441     unless ($config{'ALERTING_METHODS'} =~ /no.?syslog/i) {
442         require Unix::Syslog;
443         Unix::Syslog->import(qw(:subs :macros));
444     }
445
446     return;
447 }
448
449 sub get_mod_paths() {
450
451     my @paths = ();
452
453     $config{'FWKNOP_MOD_DIR'} = $lib_dir if $lib_dir;
454
455     unless (-d $config{'FWKNOP_MOD_DIR'}) {
456         my $dir_tmp = $config{'FWKNOP_MOD_DIR'};
457         $dir_tmp =~ s|lib/|lib64/|;
458         if (-d $dir_tmp) {
459             $config{'FWKNOP_MOD_DIR'} = $dir_tmp;
460         } else {
461             return [];
462         }
463     }
464
465     opendir D, $config{'FWKNOP_MOD_DIR'}
466         or die "[*] Could not open $config{'FWKNOP_MOD_DIR'}: $!";
467     my @dirs = readdir D;
468     closedir D;
469
470     push @paths, $config{'FWKNOP_MOD_DIR'};
471
472     for my $dir (@dirs) {
473         ### get directories like "/usr/lib/fwknop/x86_64-linux"
474         next unless -d "$config{'FWKNOP_MOD_DIR'}/$dir";
475         push @paths, "$config{'FWKNOP_MOD_DIR'}/$dir"
476             if $dir =~ m|linux| or $dir =~ m|thread|
477                 or (-d "$config{'FWKNOP_MOD_DIR'}/$dir/auto");
478     }
479     return \@paths;
480 }
481
482 sub usage() {
483     my $exit_status = shift;
484     print <<_HELP_;
485
486 fwknop_serv - Lightweight TCP socket service for fwknop SPA communications
487
488 [+] Version: $version (file revision: $rev_num)
489     By Michael Rash (mbr\@cipherdyne.org)
490     URL: http://www.cipherdyne.org/fwknop/
491
492 Usage: fwknop_serv [options]
493
494 Options:
495     -c, --config <file>         - Specify path to config file instead of
496                                   using the default path:
497                                   $config_file
498     -O, --Override-config <str> - Allow config variables from the normal
499                                   $config_file to be superseded with values
500                                   from the specified file(s).
501 _HELP_
502
503     exit $exit_status;
504 }