File Coverage

blib/lib/Net/BEEP/Lite/MgmtProfile.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             # $Id: MgmtProfile.pm,v 1.10 2003/09/11 19:57:31 davidb Exp $
2             #
3             # Copyright (C) 2003 Verisign, Inc.
4             #
5             # This library is free software; you can redistribute it and/or
6             # modify it under the terms of the GNU Lesser General Public
7             # License as published by the Free Software Foundation; either
8             # version 2.1 of the License, or (at your option) any later version.
9             #
10             # This library is distributed in the hope that it will be useful,
11             # but WITHOUT ANY WARRANTY; without even the implied warranty of
12             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13             # Lesser General Public License for more details.
14             #
15             # You should have received a copy of the GNU Lesser General Public
16             # License along with this library; if not, write to the Free Software
17             # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
18             # USA
19              
20             package Net::BEEP::Lite::MgmtProfile;
21              
22             =head1 NAME
23              
24             Net::BEEP::Lite::MgmtProfile
25              
26             =head1 SYNOPSIS
27              
28             my $mgmt_profile
29             = Net::BEEP::Lite::MgmtProfile->new(AllowMultipleChannels => 1)
30              
31             my $greeting_msg = $mgmt_profile->greeting_message($session);
32              
33             my $start_channel_msg
34             = $mgmt_profile->start_channel_message($session,
35             (URI => "http://xml.resources.org/profiles/NULL/ECHO",
36             ServerName => "localhost",
37             StartData => "echo this!"));
38              
39              
40             =head1 DESCRIPTION
41              
42             This is a subclass of C. It is the
43             special profile that deals with the BEEP channel management messages
44             that occur on channel zero. User code is not expected to instantate
45             instances of this class on their own. In general, this is created and
46             used solely by the C class and its subclasses.
47              
48             Both server and client sessions use this, as it handles both sides of
49             the conversation.
50              
51             This profile is designed to be shared between different sessions, just
52             as part of the general design principle for profiles. However, within
53             this framework (and Perl in general) this is unlikely to be actually
54             true (due to forking, or even ithreads).
55              
56             =cut
57              
58 3     3   28492 use Carp;
  3         7  
  3         269  
59 3     3   20 use strict;
  3         16  
  3         2380  
60 3     3   20 use warnings;
  3         6  
  3         98  
61              
62 3     3   1447 use XML::LibXML;
  0            
  0            
63             use MIME::Base64;
64              
65             use Net::BEEP::Lite::Message;
66             use base qw(Net::BEEP::Lite::BaseProfile);
67              
68             =head1 CONSTRUCTOR
69              
70             =over 4
71              
72             =item new( I )
73              
74             This is the main constructor for this class. It takes named
75             parameters as arguments. See the C method of this class
76             and the superclass (C) for valid argument
77             names.
78              
79             =back
80              
81             =cut
82              
83             sub new {
84             my $this = shift;
85             my $class = ref($this) || $this;
86              
87             my $self = {};
88              
89             bless $self, $class;
90              
91             $self->SUPER::initialize(@_);
92             $self->initialize(@_);
93              
94             $self->{parser} = XML::LibXML->new();
95              
96             $self;
97              
98             }
99              
100             =head1 METHODS
101              
102             =over 4
103              
104             =item initialize( I )
105              
106             Initialize the object. This takes the same arguments as the
107             constructor (Indeed, the constructor is just calling this method).
108             This method takes the following named parameters:
109              
110             =over 4
111              
112             =item AllowMultipleChannels
113              
114             if false, attempts to start more than one data channel by the peer
115             will fail. This is set to B by default.
116              
117             =back
118              
119             =cut
120              
121             sub initialize {
122             my $self = shift;
123             my %args = @_;
124              
125             # by default, we do not allow multiple channels
126             $self->{allow_multiple} = 0;
127              
128             for (keys %args) {
129             my $val = $args{$_};
130              
131             /^AllowMultipleChannels/io and do {
132             $self->allow_multiple_channels($val);
133             next;
134             };
135             }
136             }
137              
138             =item allow_multiple_channels([value])
139              
140             If an argument is given, it is used as the boolean value for whether
141             or not start channel requests should be allowed when there is already
142             an existing open channel. It returns the current (possibly just set)
143             value.
144              
145             =cut
146              
147             sub allow_multiple_channels {
148             my $self = shift;
149             my $val = shift;
150              
151             $self->{allow_multiple} = $val if defined $val;
152             $self->{allow_multiple};
153             }
154              
155             # This will parse the BEEP management channel message XML content.
156             sub _parse_message {
157             my $self = shift;
158             my $message = shift;
159              
160             my $ct = $message->content_type();
161             confess "invalid mangement channel content type ($ct)\n"
162             if $ct ne "application/beep+xml";
163              
164             my $content = $message->content();
165              
166             # parse the content.
167             my $doc = $self->{parser}->parse_string($content);
168              
169             $doc->documentElement();
170             }
171              
172             =item MSG($session, $message)
173              
174             Handle MSG type messages. This method handles BEEP "" and
175             "" messages. Returns $message.
176              
177             =cut
178              
179             sub MSG {
180             my $self = shift;
181             my $session = shift;
182             my $message = shift;
183              
184             print STDERR "MgmtProfile->handling MSG: ", $message->content(), "\n"
185             if $self->{debug};
186              
187             my $root = $self->_parse_message($message);
188             my $name = $root->nodeName;
189              
190             # handle start message.
191             if ($name eq "start") {
192              
193             # if we are not allowed to open multiple channels (in addition to
194             # the management channel), don't.
195             if ($session->num_open_channels() >= 1 and
196             !$self->allow_multiple_channels()) {
197             my $resp = $self->_error_message($message->msgno(),
198             550, "Channel creation not allowed.");
199             $session->send_message($resp);
200             return $message;
201             }
202              
203             my $number = $root->getAttribute("number");
204             my $server_name = $root->getAttribute("serverName");
205              
206             my @profile_elements = $root->getElementsByTagName("profile");
207             # for now, if there are multiple presented profiles, we just pick
208             # the first one that we support (not the "best" one).
209             my ($profile, $data, $encoded);
210             for my $pe (@profile_elements) {
211             my $uri = $pe->getAttribute("uri");
212             $profile = $session->get_local_profile($uri);
213              
214             if ($profile) {
215             my $encoding_attr = $pe->getAttribute("encoding") || "";
216             $encoded = ($encoding_attr eq "base64");
217             $data = $pe->textContent;
218             $data = decode_base64($data) if $encoded;
219             last;
220             }
221             }
222              
223             # if we don't support any of the profiles presented...
224             if (not $profile) {
225             # send the error response.
226             my $resp = $self->_error_message
227             ($message->msgno(), 550, "all requested profiles are unsupported");
228             $session->send_message($resp);
229             return $message;
230             }
231              
232             # set the server name, if we got it.
233             $session->servername($server_name);
234              
235             # get the profile's input
236             my ($resp_data, $encode);
237             my @res = $profile->start_channel_request($session, $message, $data);
238              
239             if ($res[0] and $res[0] eq 'NUL') {
240             # NUL means to do nothing at all.
241             return $message;
242             }
243             elsif ($res[0] and $res[0] eq 'ERR') {
244             # ERR means that the profile has refused the channel creation.
245             my $resp = $self->_error_message($res[1], $res[2]);
246             $session->send_message($resp);
247             return $message;
248             }
249             elsif ($res[0] and $res[0] eq 'RPY') {
250             # RPY means that the profile wants to send some response data
251             # back along with creating the channel.
252             $resp_data = $res[1];
253             $encode = $res[2] || 0;
254             $resp_data = encode_base64($resp_data) if $encode;
255             }
256             # other responses or undef means to return a plain response.
257              
258             # IMPORTANT: add the channel to the session.
259             $session->_add_channel($number, $profile);
260              
261             # return a "profile" response.
262             $self->send_profile_message($session, $message->msgno(), $profile->uri(),
263             $resp_data, $encode);
264              
265             return $message;
266             }
267             # handle close message.
268             elsif ($name eq "close") {
269              
270             my $number = $root->getAttribute("number");
271             my $code = $root->getAttribute("code");
272              
273             my $resp = $self->_new_mgmt_message(Type => 'RPY',
274             Msgno => $message->msgno(),
275             Content => "");
276              
277             $session->send_message($resp);
278              
279             # close the session if the channel number was zero.
280             if ($number == 0) {
281             # FIXME: I don't see any reason why I can't close the socket
282             # immediately after sending the "ok", but beepcore-java will
283             # throw an exception.
284              
285             # FIXME: what I really want to do is just wait for the other end
286             # to close the socket (and only close)
287             select(undef, undef, undef, 0.2);
288             $session->close_session();
289             } else {
290             # IMPORTANT: otherwise, destroy the channel.
291             $session->_del_channel($number);
292             }
293             }
294              
295             $message;
296             }
297              
298             =item RPY($session, $message)
299              
300             This method handles RPY type BEEP messages. It handles "",
301             "", and "" responses. It returns $message.
302              
303             =cut
304              
305             sub RPY {
306             my $self = shift;
307             my $session = shift;
308             my $message = shift;
309              
310             print STDERR "MgmtProfile->handling RPY:\n", $message->content(), "\n"
311             if $self->{debug};
312              
313             my $root = $self->_parse_message($message);
314             my $name = $root->nodeName;
315              
316             # handle greeting message.
317             if ($name eq "greeting") {
318              
319             my @profile_elements = $root->getElementsByTagName("profile");
320             for my $pe (@profile_elements) {
321             my $uri = $pe->getAttribute('uri');
322             $session->add_remote_profile($uri);
323             }
324              
325             }
326             # handle ok message.
327             elsif ($name eq "ok") {
328              
329             # This relies on the fact that send_close_channel_message will
330             # stow the channel to be closed in the session.
331             my $number = $session->{closing_channel_number};
332              
333             if ($number == 0) {
334             # received for close of channel zero means to close the
335             # session.
336             $session->close_session();
337             } else {
338             # we just close the requested channel.
339             $session->_del_channel($number);
340             }
341              
342             }
343             # handle 'profile' message
344             elsif ($name eq "profile") {
345              
346             # IMPORTANT: add the channel. This relies on the fact that
347             # send_start_channel_message will set the channel being started in
348             # the session.
349             $session->_add_channel($session->{starting_channel_number});
350              
351             # we probably don't need this check, since only client sessions
352             # will get this (in this implementation, anyway).
353             if ($session->can('selected_profile')) {
354             my $uri = $root->getAttribute('uri');
355             $session->selected_profile($uri);
356             }
357              
358             # if there is any response data in the
359             my $encoding_attr = $root->getAttribute("encoding") || "";
360             my $encoded = ($encoding_attr eq "base64");
361             my $data = $root->textContent;
362             $data = decode_base64($data) if $data and $encoded;
363              
364             $session->{start_channel_data} = $data if $data;
365             }
366             else {
367             confess "unknown RPY encountered: ", $message->content(), "\n";
368             }
369              
370             $message;
371             }
372              
373             =item ERR($session, $message)
374              
375             This method handles ERR type messages. Currently, it doesn't really
376             do anything with them. It returns $message.
377              
378             =cut
379              
380             sub ERR {
381             my $self = shift;
382             my $session = shift;
383             my $message = shift;
384              
385             print STDERR "got an error: ", $message->content(), "\n"
386             if $self->{debug};
387             return $message;
388             }
389              
390             =item greeting_message(@profile_uris)
391              
392             This method returns a formatted C containing a
393             valid "" message. It will advertise the profiles in
394             @profile_uris..
395              
396             =cut
397              
398             sub greeting_message {
399             my $self = shift;
400             my @profile_list = @_;
401              
402             my $greeting_el = XML::LibXML::Element->new("greeting");
403             for my $uri (@profile_list) {
404             my $profile_el = XML::LibXML::Element->new("profile");
405             $profile_el->setAttribute("uri", $uri);
406             $greeting_el->appendChild($profile_el);
407             }
408              
409             my $msg = $self->_new_mgmt_message
410             (Type => 'RPY',
411             Msgno => 0,
412             Content => $greeting_el->toString());
413              
414             $msg;
415             }
416              
417             =item send_greeting_message($session)
418              
419             Format and send the greeting message to the peer. It uses the session
420             to determine was profiles to advertise.
421              
422             =cut
423              
424             sub send_greeting_message {
425             my $self = shift;
426             my $session = shift;
427              
428             my @profile_list = $session->get_local_profile_uris();
429             my $msg = $self->greeting_message(@profile_list);
430              
431             $session->send_message($msg);
432              
433             $msg;
434             }
435              
436             =item start_channel_message( I )
437              
438             This method will return a formatted "" message. It accepts a
439             named parameter list. The following named parameters are accepted:
440              
441             =over 4
442              
443             =item Channel
444              
445             The channel number to request. This is usually assigned by the
446             session. It is required.
447              
448             =item URI
449              
450             The profile URI to request. Currently this only allows one URI. This
451             is required.
452              
453             =item ServerName
454              
455             The "server name" to present to the server. Essentially this is the
456             name the client thinks the server is. It is optional.
457              
458             =item StartData
459              
460             Data to piggyback with the start channel request. This is optional.
461              
462             =item Encoding
463              
464             Set this to true of the StartData value is base64 encoded.
465              
466             =back
467              
468             =cut
469              
470             sub start_channel_message {
471             my $self = shift;
472             my %args = @_;
473              
474             my ($number, $uri, $encoding, $servername, $data);
475             # get the optional args
476             for (keys %args) {
477             my $val = $args{$_};
478             /^Channel$/i and do {
479             $number = $val;
480             next;
481             };
482             /^URI/i and do {
483             $uri = $val;
484             next;
485             };
486             /^encoding$/i and do {
487             $encoding = $val;
488             next;
489             };
490             /^server.?name$/i and do {
491             $servername = $val;
492             next;
493             };
494             /^start.?data$/i and do {
495             $data = $val;
496             next;
497             };
498             }
499              
500             croak "start_channel_message(): missing required parameter 'Channel'\n"
501             if not $number;
502             croak "start_channel_message(): missing required parameter 'URI'\n"
503             if not $uri;
504              
505             my $start_el = XML::LibXML::Element->new("start");
506              
507             $start_el->setAttribute("number", $number);
508             $start_el->setAttribute("serverName", $servername) if $servername;
509              
510             my $profile_el = XML::LibXML::Element->new("profile");
511             $profile_el->setAttribute('uri', $uri);
512             $start_el->appendChild($profile_el);
513              
514             # FIXME: should be able to pass in a Node or string as data.
515             if ($data) {
516             if (!ref($data)) {
517             my $cdata = XML::LibXML::CDATASection->new($data);
518             $profile_el->appendChild($cdata);
519             } elsif ($data->isa('XML::LibXML::CDATASection')) {
520             $profile_el->appendChild($data);
521             }
522             $profile_el->setAttribute("encoding", "base64") if $encoding;
523             }
524              
525             my $msg = $self->_new_mgmt_message(Type => 'MSG',
526             Content => $start_el->toString());
527             $msg;
528             }
529              
530             =item send_start_channel_message($session, I)
531              
532             In addition to the session, the parameters are the same as the named
533             parameters for the C method. The 'Channel'
534             parameter may (and usually is) omitted. This method returns the
535             channel number requested, and the message itself
536              
537             =cut
538              
539             sub send_start_channel_message {
540             my $self = shift;
541             my $session = shift;
542             my %args = @_;
543              
544             $args{Channel} = $session->_next_channel_number()
545             if not $args{Channel};
546              
547             $session->{starting_channel_number} = $args{Channel};
548              
549             my $msg = $self->start_channel_message(%args);
550              
551             $session->send_message($msg);
552              
553             ($args{Channel}, $msg);
554             }
555              
556             =item close_channel_message($channel_number, [$code, $content, $lang])
557              
558             This method will return a formatted "" message. $channel_number
559             is required. $code will default to '200'. $content is optional.
560             $lang is also optional, and is only meaningful if there is content.
561              
562             =cut
563              
564             sub close_channel_message {
565             my $self = shift;
566             my $chno = shift;
567             my $code = shift || 200;
568             my $content = shift;
569             my $lang = shift;
570              
571             my $close_el = XML::LibXML::Element->new("close");
572             $close_el->setAttribute("number", $chno);
573             $close_el->setAttribute("code", $code);
574             $close_el->setAttribute("xml:lang", $lang) if $lang;
575             $close_el->appendText($content) if $content;
576              
577              
578             $self->_new_mgmt_message(Type => 'MSG',
579             Content => $close_el->toString());
580             }
581              
582             =item send_close_channel_message($session, $channel_number,
583             [$code, $content, $lang])
584              
585             This method will format and send a "" message. Except for the
586             addition of the $session parameter, the parameters are the same as
587             C.
588              
589             =cut
590              
591             sub send_close_channel_message {
592             my $self = shift;
593             my $session = shift;
594             my $chno = shift;
595              
596             my $msg = $self->close_channel_message($chno, @_);
597              
598             $session->{closing_channel_number} = $chno;
599              
600             $session->send_message($msg);
601              
602             $msg;
603             }
604              
605             =item profile_message($uri, [$content, [$encoded]])
606              
607             Generate a "" message content for $uri. If $content is
608             provided, include it as text content contained within the
609             element. If $encoded is set to true, set the 'encoding' attribute to
610             'base64'.
611              
612             =cut
613              
614             sub profile_message {
615             my $self = shift;
616             my $msgno = shift;
617             my $uri = shift;
618             my $content = shift;
619             my $encoded = shift;
620              
621             my $profile_el = XML::LibXML::Element->new("profile");
622             $profile_el->setAttribute("uri", $uri);
623              
624             if ($content) {
625             if (!ref($content)) {
626             $profile_el->appendText($content);
627             } elsif ($content->isa('XML::LibXML::Node')) {
628             $profile_el->appendChild($content);
629             }
630             }
631             $self->_new_mgmt_message(Type => 'RPY',
632             Msgno => $msgno,
633             Content => $profile_el->toString());
634             }
635              
636             =item send_profile_message($session, $uri, [$content, [$encoded]])
637              
638             Generate and send a "" message to the peer. Except for the
639             $session paramter, the parameters are the same as for the
640             C method.
641              
642             =cut
643              
644             sub send_profile_message {
645             my $self = shift;
646             my $session = shift;
647              
648             my $msg = $self->profile_message(@_);
649              
650             $session->send_message($msg);
651              
652             $msg;
653             }
654              
655              
656             # A convenience wrapper around the process of creating a new
657             # management BEEP message.
658             sub _new_mgmt_message {
659             my $self = shift;
660             my %args = @_;
661              
662             $args{Content_Type} = "application/beep+xml";
663             $args{Channel} = 0;
664              
665             Net::BEEP::Lite::Message->new(%args);
666             }
667              
668             # create a new BEEP management error message.
669             sub _error_message {
670             my $self = shift;
671             my $msgno = shift;
672             my $code = shift;
673             my $content = shift;
674              
675             my $error_el = XML::LibXML::Element->new("error");
676             $error_el->setAttribute("code", $code);
677             $error_el->appendText($content) if $content;
678              
679             $self->_new_mgmt_message(Type => 'ERR',
680             Msgno => $msgno,
681             Content => $error_el->toString());
682             }
683              
684             =pod
685              
686             =back
687              
688             =head1 SEE ALSO
689              
690             L, L, and
691             L
692              
693             =cut
694              
695             1;