1: #!/usr/bin/perl -w
2: #
3: # Copyright (c) 2007, Cameron Rich
4: #
5: # All rights reserved.
6: #
7: # Redistribution and use in source and binary forms, with or without
8: # modification, are permitted provided that the following conditions are met:
9: #
10: # * Redistributions of source code must retain the above copyright notice,
11: # this list of conditions and the following disclaimer.
12: # * Redistributions in binary form must reproduce the above copyright
13: # notice, this list of conditions and the following disclaimer in the
14: # documentation and/or other materials provided with the distribution.
15: # * Neither the name of the axTLS project nor the names of its
16: # contributors may be used to endorse or promote products derived
17: # from this software without specific prior written permission.
18: #
19: # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
20: # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
21: # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
22: # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
23: # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
24: # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
25: # TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
26: # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY
27: # OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
28: # NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
29: # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30: #
31:
32: #
33: # Demonstrate the use of the axTLS library in Perl with a set of
34: # command-line parameters similar to openssl. In fact, openssl clients
35: # should be able to communicate with axTLS servers and visa-versa.
36: #
37: # This code has various bits enabled depending on the configuration. To enable
38: # the most interesting version, compile with the 'full mode' enabled.
39: #
40: # To see what options you have, run the following:
41: # > [perl] axssl s_server -?
42: # > [perl] axssl s_client -?
43: #
44: # The axtls/axtlsp shared libraries must be in the same directory or be found
45: # by the OS. axtlsp.pm must be in this directory or be in @INC.
46: #
47: # Under Win32, ActivePerl was used (see
48: # http://www.activestate.com/Products/ActivePerl/?mp=1)
49: #
50: use axtlsp;
51: use IO::Socket;
52:
53: # To get access to Win32 file descriptor stuff
54: my $is_win32 = 0;
55:
56: if ($^O eq "MSWin32")
57: {
58: eval("use Win32API::File 0.08 qw( :ALL )");
59: $is_win32 = 1;
60: }
61:
62: use strict;
63:
64: #
65: # Win32 has some problems with socket handles
66: #
67: sub get_native_sock
68: {
69: my ($sock) = @_;
70: return $is_win32 ? FdGetOsFHandle($sock) : $sock;
71: }
72:
73: # print version?
74: if ($#ARGV == 0 && $ARGV[0] eq "version")
75: {
76: printf("axssl.pl ".axtlsp::ssl_version()."\n");
77: exit 0;
78: }
79:
80: #
81: # Main entry point. Doesn't do much except works out whether we are a client
82: # or a server.
83: #
84: print_options($#ARGV > -1 ? $ARGV[0] : "")
85: if ($#ARGV < 0 || ($ARGV[0] ne "s_server" && $ARGV[0] ne "s_client"));
86:
87:
88: # Cygwin/Win32 issue - flush our output continuously
89: select STDOUT;
90: local $|=1;
91:
92: my $build_mode = axtlsp::ssl_get_config($axtlsp::SSL_BUILD_MODE);
93: $ARGV[0] eq "s_server" ? do_server($build_mode) : do_client($build_mode);
94:
95: #
96: # Implement the SSL server logic.
97: #
98: sub do_server
99: {
100: my ($build_mode) = @_;
101: my $i = 1;
102: my $port = 4433;
103: my $options = $axtlsp::SSL_DISPLAY_CERTS;
104: my $quiet = 0;
105: my $password = undef;
106: my $private_key_file = undef;
107: my $cert_size = axtlsp::ssl_get_config($axtlsp::SSL_MAX_CERT_CFG_OFFSET);
108: my $ca_cert_size = axtlsp::ssl_get_config(
109: $axtlsp::SSL_MAX_CA_CERT_CFG_OFFSET);
110: my @cert;
111: my @ca_cert;
112:
113: while ($i <= $#ARGV)
114: {
115: if ($ARGV[$i] eq "-accept")
116: {
117: print_server_options($build_mode, $ARGV[$i]) if $i >= $#ARGV;
118: $port = $ARGV[++$i];
119: }
120: elsif ($ARGV[$i] eq "-quiet")
121: {
122: $quiet = 1;
123: $options &= ~$axtlsp::SSL_DISPLAY_CERTS;
124: }
125: elsif ($build_mode >= $axtlsp::SSL_BUILD_SERVER_ONLY)
126: {
127: if ($ARGV[$i] eq "-cert")
128: {
129: print_server_options($build_mode, $ARGV[$i])
130: if $i >= $#ARGV || $#cert >= $cert_size-1;
131:
132: push @cert, $ARGV[++$i];
133: }
134: elsif ($ARGV[$i] eq "-key")
135: {
136: print_server_options($build_mode, $ARGV[$i]) if $i >= $#ARGV;
137: $private_key_file = $ARGV[++$i];
138: $options |= $axtlsp::SSL_NO_DEFAULT_KEY;
139: }
140: elsif ($ARGV[$i] eq "-pass")
141: {
142: print_server_options($build_mode, $ARGV[$i]) if $i >= $#ARGV;
143: $password = $ARGV[++$i];
144: }
145: elsif ($build_mode >= $axtlsp::SSL_BUILD_ENABLE_VERIFICATION)
146: {
147: if ($ARGV[$i] eq "-verify")
148: {
149: $options |= $axtlsp::SSL_CLIENT_AUTHENTICATION;
150: }
151: elsif ($ARGV[$i] eq "-CAfile")
152: {
153: print_server_options($build_mode, $ARGV[$i])
154: if $i >= $#ARGV || $#ca_cert >= $ca_cert_size-1;
155: push @ca_cert, $ARGV[++$i];
156: }
157: elsif ($build_mode == $axtlsp::SSL_BUILD_FULL_MODE)
158: {
159: if ($ARGV[$i] eq "-debug")
160: {
161: $options |= $axtlsp::SSL_DISPLAY_BYTES;
162: }
163: elsif ($ARGV[$i] eq "-state")
164: {
165: $options |= $axtlsp::SSL_DISPLAY_STATES;
166: }
167: elsif ($ARGV[$i] eq "-show-rsa")
168: {
169: $options |= $axtlsp::SSL_DISPLAY_RSA;
170: }
171: else
172: {
173: print_server_options($build_mode, $ARGV[$i]);
174: }
175: }
176: else
177: {
178: print_server_options($build_mode, $ARGV[$i]);
179: }
180: }
181: else
182: {
183: print_server_options($build_mode, $ARGV[$i]);
184: }
185: }
186: else
187: {
188: print_server_options($build_mode, $ARGV[$i]);
189: }
190:
191: $i++;
192: }
193:
194: # Create socket for incoming connections
195: my $server_sock = IO::Socket::INET->new(Proto => 'tcp',
196: LocalPort => $port,
197: Listen => 1,
198: Reuse => 1) or die $!;
199:
200: ###########################################################################
201: # This is where the interesting stuff happens. Up until now we've
202: # just been setting up sockets etc. Now we do the SSL handshake.
203: ###########################################################################
204: my $ssl_ctx = axtlsp::ssl_ctx_new($options, $axtlsp::SSL_DEFAULT_SVR_SESS);
205: die "Error: Server context is invalid" if not defined $ssl_ctx;
206:
207: if (defined $private_key_file)
208: {
209: my $obj_type = $axtlsp::SSL_OBJ_RSA_KEY;
210:
211: $obj_type = $axtlsp::SSL_OBJ_PKCS8 if $private_key_file =~ /.p8$/;
212: $obj_type = $axtlsp::SSL_OBJ_PKCS12 if $private_key_file =~ /.p12$/;
213:
214: die "Private key '$private_key_file' is undefined." if
215: axtlsp::ssl_obj_load($ssl_ctx, $obj_type,
216: $private_key_file, $password);
217: }
218:
219: foreach (@cert)
220: {
221: die "Certificate '$_' is undefined."
222: if axtlsp::ssl_obj_load($ssl_ctx, $axtlsp::SSL_OBJ_X509_CERT,
223: $_, undef) != $axtlsp::SSL_OK;
224: }
225:
226: foreach (@ca_cert)
227: {
228: die "Certificate '$_' is undefined."
229: if axtlsp::ssl_obj_load($ssl_ctx, $axtlsp::SSL_OBJ_X509_CACERT,
230: $_, undef) != $axtlsp::SSL_OK;
231: }
232:
233: for (;;)
234: {
235: printf("ACCEPT\n") if not $quiet;
236: my $client_sock = $server_sock->accept;
237: my $native_sock = get_native_sock($client_sock->fileno);
238:
239: # This doesn't work in Win32 - need to get file descriptor from socket.
240: my $ssl = axtlsp::ssl_server_new($ssl_ctx, $native_sock);
241:
242: # do the actual SSL handshake
243: my $res;
244: my $buf;
245: my $connected = 0;
246:
247: while (1)
248: {
249: ($res, $buf) = axtlsp::ssl_read($ssl, undef);
250: last if $res < $axtlsp::SSL_OK;
251:
252: if ($res == $axtlsp::SSL_OK) # connection established and ok
253: {
254: if (axtlsp::ssl_handshake_status($ssl) == $axtlsp::SSL_OK)
255: {
256: if (!$quiet && !$connected)
257: {
258: display_session_id($ssl);
259: display_cipher($ssl);
260: }
261:
262: $connected = 1;
263: }
264: }
265:
266: if ($res > $axtlsp::SSL_OK)
267: {
268: printf($$buf);
269: }
270: elsif ($res < $axtlsp::SSL_OK)
271: {
272: axtlsp::ssl_display_error($res) if not $quiet;
273: last;
274: }
275: }
276:
277: # client was disconnected or the handshake failed.
278: printf("CONNECTION CLOSED\n") if not $quiet;
279: axtlsp::ssl_free($ssl);
280: $client_sock->close;
281: }
282:
283: axtlsp::ssl_ctx_free($ssl_ctx);
284: }
285:
286: #
287: # Implement the SSL client logic.
288: #
289: sub do_client
290: {
291: my ($build_mode) = @_;
292: my $i = 1;
293: my $port = 4433;
294: my $options = $axtlsp::SSL_SERVER_VERIFY_LATER|$axtlsp::SSL_DISPLAY_CERTS;
295: my $private_key_file = undef;
296: my $reconnect = 0;
297: my $quiet = 0;
298: my $password = undef;
299: my @session_id;
300: my $host = "127.0.0.1";
301: my @cert;
302: my @ca_cert;
303: my $cert_size = axtlsp::ssl_get_config(
304: $axtlsp::SSL_MAX_CERT_CFG_OFFSET);
305: my $ca_cert_size = axtlsp::ssl_get_config(
306: $axtlsp::SSL_MAX_CA_CERT_CFG_OFFSET);
307:
308: while ($i <= $#ARGV)
309: {
310: if ($ARGV[$i] eq "-connect")
311: {
312: print_client_options($build_mode, $ARGV[$i]) if $i >= $#ARGV;
313: ($host, $port) = split(':', $ARGV[++$i]);
314: }
315: elsif ($ARGV[$i] eq "-cert")
316: {
317: print_client_options($build_mode, $ARGV[$i])
318: if $i >= $#ARGV || $#cert >= $cert_size-1;
319:
320: push @cert, $ARGV[++$i];
321: }
322: elsif ($ARGV[$i] eq "-key")
323: {
324: print_client_options($build_mode, $ARGV[$i]) if $i >= $#ARGV;
325: $private_key_file = $ARGV[++$i];
326: $options |= $axtlsp::SSL_NO_DEFAULT_KEY;
327: }
328: elsif ($ARGV[$i] eq "-CAfile")
329: {
330: print_client_options($build_mode, $ARGV[$i])
331: if $i >= $#ARGV || $#ca_cert >= $ca_cert_size-1;
332:
333: push @ca_cert, $ARGV[++$i];
334: }
335: elsif ($ARGV[$i] eq "-verify")
336: {
337: $options &= ~$axtlsp::SSL_SERVER_VERIFY_LATER;
338: }
339: elsif ($ARGV[$i] eq "-reconnect")
340: {
341: $reconnect = 4;
342: }
343: elsif ($ARGV[$i] eq "-quiet")
344: {
345: $quiet = 1;
346: $options &= ~$axtlsp::SSL_DISPLAY_CERTS;
347: }
348: elsif ($ARGV[$i] eq "-pass")
349: {
350: print_server_options($build_mode, $ARGV[$i]) if $i >= $#ARGV;
351: $password = $ARGV[++$i];
352: }
353: elsif ($build_mode == $axtlsp::SSL_BUILD_FULL_MODE)
354: {
355: if ($ARGV[$i] eq "-debug")
356: {
357: $options |= $axtlsp::SSL_DISPLAY_BYTES;
358: }
359: elsif ($ARGV[$i] eq "-state")
360: {
361: $options |= $axtlsp::SSL_DISPLAY_STATES;
362: }
363: elsif ($ARGV[$i] eq "-show-rsa")
364: {
365: $options |= $axtlsp::SSL_DISPLAY_RSA;
366: }
367: else # don't know what this is
368: {
369: print_client_options($build_mode, $ARGV[$i]);
370: }
371: }
372: else # don't know what this is
373: {
374: print_client_options($build_mode, $ARGV[$i]);
375: }
376:
377: $i++;
378: }
379:
380: my $client_sock = new IO::Socket::INET (
381: PeerAddr => $host, PeerPort => $port, Proto => 'tcp')
382: || die ("no socket: $!");
383: my $ssl;
384: my $res;
385: my $native_sock = get_native_sock($client_sock->fileno);
386:
387: printf("CONNECTED\n") if not $quiet;
388:
389: ###########################################################################
390: # This is where the interesting stuff happens. Up until now we've
391: # just been setting up sockets etc. Now we do the SSL handshake.
392: ###########################################################################
393: my $ssl_ctx = axtlsp::ssl_ctx_new($options, $axtlsp::SSL_DEFAULT_CLNT_SESS);
394: die "Error: Client context is invalid" if not defined $ssl_ctx;
395:
396: if (defined $private_key_file)
397: {
398: my $obj_type = $axtlsp::SSL_OBJ_RSA_KEY;
399:
400: $obj_type = $axtlsp::SSL_OBJ_PKCS8 if $private_key_file =~ /.p8$/;
401: $obj_type = $axtlsp::SSL_OBJ_PKCS12 if $private_key_file =~ /.p12$/;
402:
403: die "Private key '$private_key_file' is undefined." if
404: axtlsp::ssl_obj_load($ssl_ctx, $obj_type,
405: $private_key_file, $password);
406: }
407:
408: foreach (@cert)
409: {
410: die "Certificate '$_' is undefined."
411: if axtlsp::ssl_obj_load($ssl_ctx, $axtlsp::SSL_OBJ_X509_CERT,
412: $_, undef) != $axtlsp::SSL_OK;
413: }
414:
415: foreach (@ca_cert)
416: {
417: die "Certificate '$_' is undefined."
418: if axtlsp::ssl_obj_load($ssl_ctx, $axtlsp::SSL_OBJ_X509_CACERT,
419: $_, undef) != $axtlsp::SSL_OK;
420: }
421:
422: # Try session resumption?
423: if ($reconnect)
424: {
425: my $session_id = undef;
426: my $sess_id_size = 0;
427:
428: while ($reconnect--)
429: {
430: $ssl = axtlsp::ssl_client_new($ssl_ctx, $native_sock,
431: $session_id, $sess_id_size);
432:
433: $res = axtlsp::ssl_handshake_status($ssl);
434: if ($res != $axtlsp::SSL_OK)
435: {
436: axtlsp::ssl_display_error($res) if !$quiet;
437: axtlsp::ssl_free($ssl);
438: exit 1;
439: }
440:
441: display_session_id($ssl);
442: $session_id = axtlsp::ssl_get_session_id($ssl);
443:
444: if ($reconnect)
445: {
446: axtlsp::ssl_free($ssl);
447: $client_sock->close;
448: $client_sock = new IO::Socket::INET (
449: PeerAddr => $host, PeerPort => $port, Proto => 'tcp')
450: || die ("no socket: $!");
451:
452: }
453: }
454: }
455: else
456: {
457: $ssl = axtlsp::ssl_client_new($ssl_ctx, $native_sock, undef, 0);
458: }
459:
460: # check the return status
461: $res = axtlsp::ssl_handshake_status($ssl);
462: if ($res != $axtlsp::SSL_OK)
463: {
464: axtlsp::ssl_display_error($res) if not $quiet;
465: exit 1;
466: }
467:
468: if (!$quiet)
469: {
470: my $common_name = axtlsp::ssl_get_cert_dn($ssl,
471: $axtlsp::SSL_X509_CERT_COMMON_NAME);
472:
473: printf("Common Name:\t\t\t%s\n", $common_name) if defined $common_name;
474: display_session_id($ssl);
475: display_cipher($ssl);
476: }
477:
478: while (<STDIN>)
479: {
480: my $cstring = pack("a*x", $_); # add null terminator
481: $res = axtlsp::ssl_write($ssl, \$cstring, length($cstring));
482: if ($res < $axtlsp::SSL_OK)
483: {
484: axtlsp::ssl_display_error($res) if not $quiet;
485: last;
486: }
487: }
488:
489: axtlsp::ssl_ctx_free($ssl_ctx);
490: $client_sock->close;
491: }
492:
493: #
494: # We've had some sort of command-line error. Print out the basic options.
495: #
496: sub print_options
497: {
498: my ($option) = @_;
499: printf("axssl: Error: '%s' is an invalid command.\n", $option);
500: printf("usage: axssl [s_server|s_client|version] [args ...]\n");
501: exit 1;
502: }
503:
504: #
505: # We've had some sort of command-line error. Print out the server options.
506: #
507: sub print_server_options
508: {
509: my ($build_mode, $option) = @_;
510: my $cert_size = axtlsp::ssl_get_config($axtlsp::SSL_MAX_CERT_CFG_OFFSET);
511: my $ca_cert_size = axtlsp::ssl_get_config(
512: $axtlsp::SSL_MAX_CA_CERT_CFG_OFFSET);
513:
514: printf("unknown option %s\n", $option);
515: printf("usage: s_server [args ...]\n");
516: printf(" -accept arg\t- port to accept on (default is 4433)\n");
517: printf(" -quiet\t\t- No server output\n");
518:
519: if ($build_mode >= $axtlsp::SSL_BUILD_SERVER_ONLY)
520: {
521: printf(" -cert arg\t- certificate file to add (in addition to default)".
522: " to chain -\n".
523: "\t\t Can repeat up to %d times\n", $cert_size);
524: printf(" -key arg\t- Private key file to use - default DER format\n");
525: printf(" -pass\t\t- private key file pass phrase source\n");
526: }
527:
528: if ($build_mode >= $axtlsp::SSL_BUILD_ENABLE_VERIFICATION)
529: {
530: printf(" -verify\t- turn on peer certificate verification\n");
531: printf(" -CAfile arg\t- Certificate authority - default DER format\n");
532: printf("\t\t Can repeat up to %d times\n", $ca_cert_size);
533: }
534:
535: if ($build_mode == $axtlsp::SSL_BUILD_FULL_MODE)
536: {
537: printf(" -debug\t\t- Print more output\n");
538: printf(" -state\t\t- Show state messages\n");
539: printf(" -show-rsa\t- Show RSA state\n");
540: }
541:
542: exit 1;
543: }
544:
545: #
546: # We've had some sort of command-line error. Print out the client options.
547: #
548: sub print_client_options
549: {
550: my ($build_mode, $option) = @_;
551: my $cert_size = axtlsp::ssl_get_config($axtlsp::SSL_MAX_CERT_CFG_OFFSET);
552: my $ca_cert_size = axtlsp::ssl_get_config(
553: $axtlsp::SSL_MAX_CA_CERT_CFG_OFFSET);
554:
555: printf("unknown option %s\n", $option);
556:
557: if ($build_mode >= $axtlsp::SSL_BUILD_ENABLE_CLIENT)
558: {
559: printf("usage: s_client [args ...]\n");
560: printf(" -connect host:port - who to connect to (default ".
561: "is localhost:4433)\n");
562: printf(" -verify\t- turn on peer certificate verification\n");
563: printf(" -cert arg\t- certificate file to use - default DER format\n");
564: printf(" -key arg\t- Private key file to use - default DER format\n");
565: printf("\t\t Can repeat up to %d times\n", $cert_size);
566: printf(" -CAfile arg\t- Certificate authority - default DER format\n");
567: printf("\t\t Can repeat up to %d times\n", $ca_cert_size);
568: printf(" -quiet\t\t- No client output\n");
569: printf(" -pass\t\t- private key file pass phrase source\n");
570: printf(" -reconnect\t- Drop and re-make the connection ".
571: "with the same Session-ID\n");
572:
573: if ($build_mode == $axtlsp::SSL_BUILD_FULL_MODE)
574: {
575: printf(" -debug\t\t- Print more output\n");
576: printf(" -state\t\t- Show state messages\n");
577: printf(" -show-rsa\t- Show RSA state\n");
578: }
579: }
580: else
581: {
582: printf("Change configuration to allow this feature\n");
583: }
584:
585: exit 1;
586: }
587:
588: #
589: # Display what cipher we are using
590: #
591: sub display_cipher
592: {
593: my ($ssl) = @_;
594: printf("CIPHER is ");
595: my $cipher_id = axtlsp::ssl_get_cipher_id($ssl);
596:
597: if ($cipher_id == $axtlsp::SSL_AES128_SHA)
598: {
599: printf("AES128-SHA");
600: }
601: elsif ($cipher_id == $axtlsp::SSL_AES256_SHA)
602: {
603: printf("AES256-SHA");
604: }
605: elsif ($axtlsp::SSL_RC4_128_SHA)
606: {
607: printf("RC4-SHA");
608: }
609: elsif ($axtlsp::SSL_RC4_128_MD5)
610: {
611: printf("RC4-MD5");
612: }
613: else
614: {
615: printf("Unknown - %d", $cipher_id);
616: }
617:
618: printf("\n");
619: }
620:
621: #
622: # Display what session id we have.
623: #
624: sub display_session_id
625: {
626: my ($ssl) = @_;
627: my $session_id = axtlsp::ssl_get_session_id($ssl);
628: if (length($$session_id) > 0)
629: {
630: printf("-----BEGIN SSL SESSION PARAMETERS-----\n");
631: printf(unpack("H*", $$session_id));
632: printf("\n-----END SSL SESSION PARAMETERS-----\n");
633: }
634: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to axssl.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / axTLS / samples / perl