# ========================================================================== # # Perl WS-Security header for SOAP::WSDL # Copyright (C) 2014 Jan M. Hochstein # # 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # ========================================================================== # # Serializer with WS-Security header for SOAP::WSDL # package WSSecurity::SecuritySerializer; use strict; use warnings; use SOAP::WSDL::Factory::Serializer; use Time::Local; use Digest::SHA; use MIME::Base64; use base qw( ONVIF::Serializer::Base ); use version; our $VERSION = qv('1.00.00'); use constant URI_SOAP11_ENV => "http://schemas.xmlsoap.org/soap/envelope/"; use constant URI_SOAP12_ENV => "http://www.w3.org/2003/05/soap-envelope"; #SOAP::WSDL::Factory::Serializer->register( '1.1' , __PACKAGE__ ); my %username_of :ATTR(:name :default<()>); my %password_of :ATTR(:name :default<()>); #sub BUILD #{ # my ($self, $ident, $args_ref) = @_; # $soapversion_of{ $ident } = '1.2'; #} SUBFACTORY: { for (qw(username password)) { my $setter = "set_$_"; my $getter = "get_$_"; no strict qw(refs); ## no critic ProhibitNoStrict *{ $_ } = sub { my $self = shift; if (@_) { $self->$setter(@_); return $self; } return $self->$getter() }; } } # # ############################################################################# # # the following methods have been adapted from an example implementation at # http://www.wlp-systems.de/soap-lite-and-ws-security # sub timestamp { my ($sec,$min,$hour,$mday,$mon,$year,undef,undef,undef) = gmtime(time); $mon++; $year = $year + 1900; return sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ",$year,$mon,$mday,$hour,$min,$sec); } sub create_generator { my ($name,$start_with) = @_; my $i = $start_with; return sub { $name . ++$i; }; } *default_nonce_generator = create_generator( "a value of ", int(1000*rand()) ); sub ws_authen { my($username,$password,$nonce_generator) = @_; if(!defined($nonce_generator)) { $nonce_generator = \&default_nonce_generator; } my $nonce = $nonce_generator->(); my $timestamp = timestamp(); my $pwDigest = Digest::SHA::sha1( $nonce . $timestamp . $password ); my $passwordHash = MIME::Base64::encode_base64($pwDigest,""); my $nonceHash = MIME::Base64::encode_base64($nonce,""); my $auth = < $username $passwordHash $nonceHash $timestamp END # warn "Auth Header is: " . $auth; $auth; } # # ############################################################################# # sub security_header { my ($self) = @_; return ws_authen($self->username, $self->password, ); } sub serialize_header() { my ($self, $method, $data, $opt) = @_; my $SOAP_NS = URI_SOAP11_ENV; if($self->soap_version() eq '1.2') { $SOAP_NS = URI_SOAP12_ENV; } # header is optional. Leave out if there's no header data return join ( q{}, "<$opt->{ namespace }->{ $SOAP_NS }\:Header>", $self->security_header(), ( $data && blessed $data ) ? $data->serialize_qualified : (), "{ namespace }->{ $SOAP_NS }\:Header>", ); } 1;