[network-manager-fortisslvpn] contrib: add protocol debugging tools
- From: Lubomir Rintel <lkundrak src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [network-manager-fortisslvpn] contrib: add protocol debugging tools
- Date: Sat, 19 Sep 2015 10:30:56 +0000 (UTC)
commit 1c6ebe76436c7d11d6bf867f613b7f781bcd5475
Author: Lubomir Rintel <lkundrak v3 sk>
Date: Sat Sep 19 12:29:26 2015 +0200
contrib: add protocol debugging tools
Makefile.am | 5 +-
contrib/README | 7 +
contrib/fortiserve.pl | 394 +++++++++++++++++++++++++++++++++++++++++++++++++
contrib/sslproxy.pl | 204 +++++++++++++++++++++++++
4 files changed, 609 insertions(+), 1 deletions(-)
---
diff --git a/Makefile.am b/Makefile.am
index 907ef84..debfa45 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -25,7 +25,10 @@ EXTRA_DIST = nm-fortisslvpn-service.name.in \
$(iconfile) \
intltool-extract.in \
intltool-merge.in \
- intltool-update.in
+ intltool-update.in \
+ contrib/README \
+ contrib/fortiserve.pl \
+ contrib/sslproxy.pl
CLEANFILES = $(nmvpnservice_DATA) $(desktop_DATA) *~
DISTCLEANFILES = intltool-extract intltool-merge intltool-update
diff --git a/contrib/README b/contrib/README
new file mode 100644
index 0000000..a8e7a90
--- /dev/null
+++ b/contrib/README
@@ -0,0 +1,7 @@
+There are various tools useful for debugging the openfortivpn connections
+in this directory. They may aid protocol analysis and automated testing:
+
+fortiserve.pl - mockup SSLVPN server
+sslproxy.pl - SSL traffic logging proxy for protocol analysis
+
+Please use perldoc(1) to view full documentation.
diff --git a/contrib/fortiserve.pl b/contrib/fortiserve.pl
new file mode 100644
index 0000000..ea982e4
--- /dev/null
+++ b/contrib/fortiserve.pl
@@ -0,0 +1,394 @@
+#!/usr/bin/env perl
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+#
+# (C) 2015 Lubomir Rintel
+
+=head1 NAME
+
+fortiserve.pl - mockup SSLVPN server
+
+=head1 SYNOPSIS
+
+fortiserve.pl
+[-h|--help|-H|--man] |
+--cert <file>
+--key <file>
+--listen <address>:<port>
+
+=head1 DESCRIPTION
+
+B<fortiserve.pl> creates a server for SSLVPN client. It tries to mimic
+the Fortinet-compatible behavior for the purposes of testing the client.
+
+=cut
+
+use HTTP::Daemon::SSL;
+use HTTP::Request;
+use HTTP::Response;
+use IO::Pty;
+use IO::Poll;
+use Getopt::Long;
+use Pod::Usage;
+
+use strict;
+use warnings;
+
+# Gereate a RFC 1662 (appendix C.1) FCS-16 table
+sub fcs16
+{
+ my @fcs16;
+
+ for (my $b = 0; $b < 256; $b++) {
+ my $v = $b;
+ $v = ($v & 1) ? ($v >> 1) ^ 0x8408 : ($v >> 1) foreach (0..7);
+ push @fcs16, $v & 0xffff;
+ }
+
+ return @fcs16;
+}
+
+# Calculate a RFC 1662 FCS-16 checksum
+sub checksum
+{
+ my @bytes = map { ord ($_) } split '', shift;
+ my $sum = 0xffff;
+
+ our @fcs16;
+ BEGIN { @fcs16 = fcs16 () };
+
+ $sum = ($sum >> 8) ^ $fcs16[0xff & ($sum ^ $_)] foreach @bytes;
+ return $sum;
+}
+
+# Decode one HDLC-like frame without the 0x7e boundaries,
+# returns the payload without checksum and address control word
+sub decode
+{
+ my @bytes = map { ord ($_) } split '', shift;
+ my $buf = '';
+
+ while (@bytes) {
+ my $byte = shift @bytes;
+
+ if ($byte == 0x7d) {
+ die unless @bytes;
+ $byte = (shift @bytes) ^ 0x20;
+ } elsif ($byte < 0x20) {
+ next;
+ }
+
+ $buf .= chr ($byte);
+ }
+
+ my $cksum = checksum ($buf);
+ warn if $cksum ne 0xf0b8;
+
+ # Checksum
+ $buf =~ s/..$//;
+
+ # Control word: Address
+ $buf =~ s/^\xff\x03//;
+
+ return $buf;
+}
+
+# Encode one HDLC-like frame, with a 0x7e delimiter at the end
+sub encode
+{
+ my $packet = "\xff\x03".shift;
+ my $cksum = checksum ($packet) ^ 0xffff;
+ $packet .= chr ($cksum & 0xff).chr ($cksum >> 8);
+ my @bytes = map { ord ($_) } split '', $packet;
+ my $buf = '';
+
+ while (@bytes) {
+ my $byte = shift @bytes;
+ my $byte7 = $byte & 0x7f;
+
+ if ($byte < 0x20 or $byte7 == 0x7d or $byte7 == 0x7e) {
+ $buf .= "\x7d";
+ $byte ^= 0x20;
+ }
+ $buf .= chr ($byte);
+ }
+
+ $buf .= "\x7e";
+
+ return $buf;
+}
+
+# Decode the HDLC-like frame and extend with the VPNSSL header
+sub pty_decode
+{
+ my $in = shift;
+ my $out = shift;
+
+ my $data;
+ ($data, $$in) = $$in =~ /(.*\x7e)(.*)/ or return;
+ $data =~ s/^\x7e//;
+ my @packets = split "\x7e", $data;
+
+ foreach my $packet (@packets) {
+ my $decoded = decode ($packet);
+ my $len = length $decoded;
+ $$out .= pack ('nnna*', $len + 6, 0x5050, $len, $decoded);
+ }
+}
+
+# Chop off the VPNSSL header, returning the HDLC-like packet
+sub client_decode
+{
+ my $in = shift;
+ my $out = shift;
+
+ while (length $$in >= 6) {
+ my ($l2, $magic, $len, $data) = unpack ('nnn a*', $$in);
+
+ warn unless $magic == 0x5050;
+ warn unless $l2 == $len + 6;
+ last unless length $data >= $len;
+ ($data, $$in) = unpack ("a$len a*", $data);
+ $$out .= encode ($data);
+ }
+}
+
+# Spawn PPP and connect it to the HTTP client socket
+sub do_ppp
+{
+ my $client = shift;
+
+ my $poll = new IO::Poll;
+ my $pty = new IO::Pty;
+ my $pppd = fork;
+
+ my $client_in = '';
+ my $pty_in = '';
+ my $client_out = '';
+ my $pty_out = "\x7e";
+
+ die $! unless defined $pppd;
+
+ # This disables echo. pppd would disable it too, however the client
+ # might race for a chance to talk to us before pppd sets things up and
+ # then the client's traffic would be just looped back.
+ $pty->slave->set_raw;
+ $pty->set_raw;
+
+ $pty->blocking (0);
+ $client->blocking (0);
+
+ # debug logfile chudak
+ exec ('pppd', $pty->ttyname, qw/38400 noipdefault noaccomp noauth
+ ms-dns 6.6.6.7 ms-dns 8.8.8.8 noccp
+ default-asyncmap nopcomp nodefaultroute :1.1.1.2 nodetach
+ lcp-max-configure 40 usepeerdns mru 1024/) or die $! unless $pppd;
+
+ $poll->mask ($_ => IO::Poll::POLLIN | IO::Poll::POLLERR)
+ foreach ($client, $pty);
+
+ do {
+ die $! if $poll->poll == -1;
+
+ if ($poll->events ($client) == IO::Poll::POLLIN) {
+ my $buf;
+ $client->sysread ($buf, 4096);
+ exit unless length $buf;
+ goto LOGOUT if $buf =~ /^GET/; # *Le sigh* ...
+ $client_in .= $buf;
+ client_decode (\$client_in, \$pty_out);
+ }
+ if ($poll->events ($pty) == IO::Poll::POLLIN) {
+ my $buf;
+ $pty->sysread ($buf, 4096);
+ exit unless length $buf;
+ $pty_in .= $buf;
+ pty_decode (\$pty_in, \$client_out);
+ }
+
+ # XXX: these can fail; poll for POLLOUT too!
+ if ($client_out) {
+ print $client $client_out;
+ $client->flush;
+ $client_out = '';
+ }
+ if ($pty_out) {
+ print $pty $pty_out;
+ $pty->flush;
+ $pty_out = '';
+ }
+ } until ($poll->handles (IO::Poll::POLLERR));
+
+LOGOUT:
+ $client->blocking (1);
+
+ kill 'TERM' => $pppd;
+}
+
+# Dispatch a response for an URI
+sub serve_request
+{
+ my $client = shift;
+ my $request = shift;
+
+ my $response;
+
+ if ($request->uri eq '/remote/logincheck') {
+ $response = new HTTP::Response (200 => 'OK', [], 'something');
+ $response->header ('Set-Cookie' => 'SVPNCOOKIE=something;');
+ } elsif ($request->uri eq '/remote/index') {
+ $response = new HTTP::Response (200 => 'OK', [], 'something');
+ } elsif ($request->uri eq '/remote/fortisslvpn') {
+ $response = new HTTP::Response (200 => 'OK', [], "\x00\x06\x50\x50\x00\x00");
+ } elsif ($request->uri eq '/remote/sslvpn-tunnel') {
+ do_ppp ($client);
+ $response = new HTTP::Response (200 => 'OK', 'something');
+ } elsif ($request->uri eq '/remote/logout') {
+ $response = new HTTP::Response (200 => 'OK', 'something');
+ } else {
+ $response = new HTTP::Response (404 => 'Not funny', [Connection => 'close']);
+ }
+
+ $client->send_response ($response) if $response;
+ #$client->close;
+}
+
+# Handle a HTTP keep-alive connection
+sub serve_client
+{
+ my $client = shift;
+
+ while (my $request = $client->get_request) {
+ serve_request ($client, $request);
+ }
+
+ $client->close;
+ exit;
+}
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-h>, B<--help>
+
+Print a brief help message and exits.
+
+=item B<-H>, B<--man>
+
+Prints the manual page and exits.
+
+=item B<--listen> B<< <address>:<port> >>
+
+Listen for connections on then specified address.
+
+Defaults to C<0.0.0.0:10443>.
+
+=item B<--cert> B<< <file> >>
+
+Use the specified server certificate for incoming connections.
+
+Defaults to F<server.crt>.
+
+=item B<--key> B<< <file> >>
+
+Use the specified key to decrypt the server certificate.
+
+Defaults to F<server.key>.
+
+=back
+
+=cut
+
+my $local = '0.0.0.0:10443';
+my $cert = 'server.crt';
+my $key = 'server.key';
+
+new Getopt::Long::Parser (config => ['no_ignore_case'])->getoptions (
+ 'local=s' => \$local,
+ 'cert=s' => \$cert,
+ 'key=s' => \$key,
+ 'h|help' => sub { pod2usage (-exitval => 0, -verbose => 1) },
+ 'H|man' => sub { pod2usage (-exitval => 0, -verbose => 2) },
+) or pod2usage (2);
+
+my $server = new HTTP::Daemon::SSL (
+ LocalAddr => $local,
+ SSL_cert_file => $cert,
+ SSL_key_file => $key,
+ ReuseAddr => 1,
+ ReusePort => 1,
+) or die;
+
+while (1) {
+ my $client = $server->accept or warn $!;
+ next unless $client;
+ my $pid = fork;
+ die $! unless defined $pid;
+ serve_client ($client) if not $pid;
+}
+
+=head1 EXAMPLES
+
+=over
+
+=item B<openssl req -out server.crt -newkey rsa:1024 -batch -nodes -x509 -keyout server.key>
+
+Generate a certificate for use with B<fortiserve.pl>.
+
+=item B<fortiserve.pl --cert server.crt --key server.key>
+
+Listen on the default C<localhost:10443> address.
+
+=item B<openfortivpn -u user -p passwd localhost:10443>
+
+Open a connection using the L<openfortivpn(1)> client.
+
+=back
+
+=head1 BUGS
+
+The protocol is not documented.
+
+The server is not suitable for production use and is mostly intended for
+interoperability testing.
+
+The pppd settings such as the addresses or DNS are hardcoded.
+
+Certain resources such as FortiOS 5 XML network settings are not implemented.
+
+Does not work with the official client.
+
+Implements no security and authentication.
+
+Sends bogus response bodies just so that L<HTTP::Daemon> has some
+C<Content-Size> to use and doesn't terminate HTTP/1.1 Keep-Alive.
+
+=head1 SEE ALSO
+
+L<openfortivpn(1)>
+
+=head1 COPYRIGHT
+
+Copyright 2015 Lubomir Rintel
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as NetworkManager-fortisslvpn itself.
+
+=head1 AUTHOR
+
+Lubomir Rintel C<lkundrak v3 sk>
+
+=cut
diff --git a/contrib/sslproxy.pl b/contrib/sslproxy.pl
new file mode 100644
index 0000000..4f43227
--- /dev/null
+++ b/contrib/sslproxy.pl
@@ -0,0 +1,204 @@
+#!/usr/bin/env perl
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+#
+# (C) 2015 Lubomir Rintel
+
+use IO::Socket::SSL;
+use IO::Poll;
+use Getopt::Long;
+use Pod::Usage;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+sslproxy.pl - SSL traffic logging proxy for protocol analysis
+
+=head1 SYNOPSIS
+
+sslproxy.pl
+[-h|--help|-H|--man] |
+--cert <file>
+--key <file>
+--listen <address>:<port>
+--backend <address>:<port>
+
+=head1 DESCRIPTION
+
+B<sslproxy.pl> connects to the backend and listens on connections,
+forwarding the traffic back and forth to the backend while intercepting
+the SSL encryption. It logs the unencrypted traffic on the standard output.
+
+You need to specify a certificate/key pair for the client-facing
+connections used instead of the pair used by the backend so that the proxy
+can decrypt it.
+
+=cut
+
+sub dump_chunk
+{
+ print join ' ', shift."[$$]:",
+ map { sprintf '%02x', ord ($_) }
+ split '', shift;
+ print "\n";
+}
+
+sub serve_client
+{
+ my $client = shift;
+
+ my $backend = new IO::Socket::SSL (
+ SSL_verify_mode => SSL_VERIFY_NONE,
+ PeerAddr => shift,
+ ) or die $!;
+
+ my $poll = new IO::Poll;
+ $poll->mask ($_ => IO::Poll::POLLIN | IO::Poll::POLLERR)
+ foreach ($client, $backend);
+
+ print "connected: $$\n";
+ do {
+ die $! if $poll->poll == -1;
+
+ if ($poll->events ($client) == IO::Poll::POLLIN) {
+ my $buf;
+ $client->sysread ($buf, 4096);
+ dump_chunk ('client', $buf);
+ exit unless length $buf;
+ print $backend $buf;
+ }
+ if ($poll->events ($backend) == IO::Poll::POLLIN) {
+ my $buf;
+ $backend->sysread ($buf, 4096);
+ dump_chunk ('backend', $buf);
+ exit unless length $buf;
+ print $client $buf;
+ }
+ } until ($poll->handles (IO::Poll::POLLERR));
+
+ exit;
+}
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-h>, B<--help>
+
+Print a brief help message and exits.
+
+=item B<-H>, B<--man>
+
+Prints the manual page and exits.
+
+=item B<--local> B<< <address>:<port> >>
+
+Listen for connections on then specified address.
+
+Defaults to C<0.0.0.0:1443>.
+
+=item B<--backend> B<< <address>:<port> >>
+
+Connect to the specified address.
+
+Defaults to C<localhost:10443>.
+
+=item B<--cert> B<< <file> >>
+
+Use the specified server certificate for incoming connections.
+
+Defaults to F<server.crt>.
+
+=item B<--key> B<< <file> >>
+
+Use the specified key to decrypt the server certificate.
+
+Defaults to F<server.key>.
+
+=back
+
+=cut
+
+my $local = '0.0.0.0:1443';
+my $backend = 'localhost:10443';
+my $cert = 'server.crt';
+my $key = 'server.key';
+
+new Getopt::Long::Parser (config => ['no_ignore_case'])->getoptions (
+ 'local=s' => \$local,
+ 'backend=s' => \$backend,
+ 'cert=s' => \$cert,
+ 'key=s' => \$key,
+ 'h|help' => sub { pod2usage (-exitval => 0, -verbose => 1) },
+ 'H|man' => sub { pod2usage (-exitval => 0, -verbose => 2) },
+) or pod2usage (2);
+
+my $server = new IO::Socket::SSL (
+ Listen => 10,
+ LocalAddr => $local,
+ SSL_cert_file => $cert,
+ SSL_key_file => $key,
+ ReuseAddr => 1,
+ ReusePort => 1,
+) or die;
+
+while (1) {
+ my $client = $server->accept or warn $!;
+ next unless $client;
+ my $pid = fork;
+ die $! unless defined $pid;
+ serve_client ($client, $backend) if not $pid;
+}
+
+=head1 EXAMPLES
+
+=over
+
+=item B<openssl req -out server.crt -newkey rsa:1024 -batch -nodes -x509 -keyout server.key>
+
+Generate a certificate for use with B<sslproxy.pl>.
+
+=item B<sslproxy.pl --cert server.crt --key server.key --backend google.com:443>
+
+Listen on the default C<localhost:1443> address, forwarding requests to C<google.com:443>.
+
+=item B<curl -k https://localhost:1443/>
+
+Issue a request against the logging backend with L<curl(1)>.
+
+=back
+
+=head1 BUGS
+
+The certificate of the backend server is not verified.
+
+=head1 SEE ALSO
+
+L<req(1)>, L<s_server(1)>, L<s_client(1)>
+
+=head1 COPYRIGHT
+
+Copyright 2015 Lubomir Rintel
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as NetworkManager-fortisslvpn itself.
+
+=head1 AUTHOR
+
+Lubomir Rintel C<lkundrak v3 sk>
+
+=cut
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
