diff options
| author | root <root@lamia.panaceas.james.local> | 2015-06-05 13:25:19 +0100 |
|---|---|---|
| committer | root <root@lamia.panaceas.james.local> | 2015-06-05 13:25:19 +0100 |
| commit | f573795110f74db407558036699bb124900e5ccd (patch) | |
| tree | c35a463e698d30f5e716d369c6502d4075e67532 | |
| parent | 9859c681f2ead3daa03154d93363a3337da10887 (diff) | |
| download | inf-f573795110f74db407558036699bb124900e5ccd.tar.gz inf-f573795110f74db407558036699bb124900e5ccd.tar.bz2 inf-f573795110f74db407558036699bb124900e5ccd.zip | |
add support for HP ilo remote consoles
| -rw-r--r-- | HTTP/Server/Brick.pm | 722 | ||||
| -rw-r--r-- | INF.pm | 4 | ||||
| -rw-r--r-- | INF/ILO.pm | 401 | ||||
| -rw-r--r-- | Makefile | 11 | ||||
| -rwxr-xr-x | ilo/certs | 38 | ||||
| -rw-r--r-- | ilo/intgapp_221.jar | bin | 0 -> 374079 bytes | |||
| -rw-r--r-- | ilo/mypolicy | 7 | ||||
| -rw-r--r-- | ilo/server.cnf | 19 | ||||
| -rw-r--r-- | ilo/server.crt | 14 | ||||
| -rw-r--r-- | ilo/server.jks | bin | 0 -> 600 bytes | |||
| -rw-r--r-- | ilo/server.key | 16 | ||||
| -rwxr-xr-x | inf.pl | 2 |
12 files changed, 1233 insertions, 1 deletions
diff --git a/HTTP/Server/Brick.pm b/HTTP/Server/Brick.pm new file mode 100644 index 0000000..b54a48a --- /dev/null +++ b/HTTP/Server/Brick.pm @@ -0,0 +1,722 @@ +package HTTP::Server::Brick; + +use version; +our $VERSION = qv('0.1.0'); + +# $Id: Brick.pm,v 1.23 2007/07/24 09:54:46 aufflick Exp $ + +=head1 NAME + +HTTP::Server::Brick - Simple pure perl http server for prototyping "in the style of" Ruby's WEBrick + + +=head1 VERSION + +This document describes HTTP::Server::Brick version 0.1.0 + + +=head1 SYNOPSIS + + use HTTP::Server::Brick; + use HTTP::Status; + + my $server = HTTP::Server::Brick->new( port => 8888 ); + + $server->mount( '/foo/bar' => { + path => '/some/directory/htdocs', + }); + + $server->mount( '/test/proc' => { + handler => sub { + my ($req, $res) = @_; + $res->add_content("<html><body> + <p>Path info: $req->{path_info}</p> + </body></html>"); + 1; + }, + wildcard => 1, + }); + + $server->mount( '/test/proc/texty' => { + handler => sub { + my ($req, $res) = @_; + $res->add_content("flubber"); + $res->header('Content-type', 'text/plain'); + 1; + }, + wildcard => 1, + }); + + # these next two are equivalent + $server->mount( '/favicon.ico' => { + handler => sub { RC_NOT_FOUND }, + }); + $server->mount( '/favicon.ico' => { + handler => sub { + my ($req, $res) = @_; + $res->code(RC_NOT_FOUND); + 1; + }, + }); + + # start accepting requests (won't return unless/until process + # receives a HUP signal) + $server->start; + +For an SSL (https) server, replace the C<new()> line above with: + + use HTTP::Daemon::SSL; + + my $server = HTTP::Server::Brick->new( + port => 8889, + daemon_class => 'HTTP::Daemon::SSL', + daemon_args => [ + SSL_key_file => 'my_ssl_key.pem', + SSL_cert_file => 'my_ssl_cert.pem', + ], + ); + +See the docs of L<HTTP::Daemon::SSL> for other options. + +=head1 DESCRIPTION + +HTTP::Server::Brick allows you to quickly wrap a prototype web server around some +Perl code. The underlying server daemon is HTTP::Daemon and the performance should +be fine for demo's, light internal systems, etc. + +=head1 METHODS + +=cut + +use warnings; +use strict; + +use HTTP::Daemon; +use HTTP::Status; +use LWP::MediaTypes; + +use constant DEBUG => $ENV{DEBUG} || 0; + + +my $__singleton; +my $__server_should_run = 0; + +$SIG{__WARN__} = sub { $__singleton ? $__singleton->_log( error => '[warn] ' . shift ) : CORE::warn(@_) }; +$SIG{__DIE__} = sub { + CORE::die (@_) if $^S; # don't interfere with eval + $__singleton->_log( error => '[die] ' . $_[0] ) if $__singleton; + CORE::die (@_) +}; +$SIG{HUP} = sub { $__server_should_run = 0; }; + + +=head2 new + +C<new> takes nine named arguments (all of which are optional): + +=over + +=item error_log, access_log + +Should be self-explanatory - can be anything that responds to C<print> eg. +file handle, IO::Handle, etc. Default to stderr and stdout respectively. + +=item port + +The port to listen on. Defaults to a random high port (you'll see it in the error log). + +=item host + +The server hostname. Defaults to something sensible. + +=item timeout + +Used for various timout values - see L<HTTP::Daemon> for more information. + +=item directory_index_file + +The filename for directory indexing. Note that this only applies to static path mounts. +Defaults to C<index.html>. + +=item directory_indexing + +If no index file is available (for a static path mount), do you want a clickable list +of files in the directory be rendered? Defaults to true. + +=item leave_sig_pipe_handler_alone + +HTTP::Daemon, the http server module this package is built on, chokes in certain multiple-request +situations unless you ignore PIPE signals. By default PIPE signals are ignored as soon as you start +the server (and restored if the server exits via HUP). If you want to handle PIPE signals your own +way, pass in a true value for this. + +If this makes no sense to you, just ignore it - the "right thing" will happen by default. + +=item daemon_class + +The class which actually handles webserving. The default is C<HTTP::Daemon>. +If you want SSL, use C<HTTP::Daemon::SSL>. Whatever class you use must inherit +from HTTP::Daemon. + +=item daemon_args + +Sometimes you need to pass extra arguments to your C<daemon_class>, e.g. SSL +configuration. This arrayref will be dereferenced and passed to C<new>. + +=back + +=cut + +sub new { + my ($this, %args) = @_; + my $class = ref($this) || $this; + + if ($args{daemon_class} and not + eval { $args{daemon_class}->isa('HTTP::Daemon') }) { + die "daemon_class argument '$args{daemon_class}'" . + " must inherit from HTTP::Daemon"; + } + + my $self = bless { + _site_map => [], + error_log => \*STDERR, + access_log => \*STDOUT, + directory_index_file => 'index.html', + directory_indexing => 1, + daemon_class => 'HTTP::Daemon', + daemon_args => [], + %args, + }, $class; + + $__singleton = $self; + + return $self; +} + +=head2 mount + +C<mount> takes two positional arguments. The first a full uri (as +a string beginning with '/' - any trailing '/' will be stripped). The +second is a hashref which serves as a spec for the mount. The allowable +hash keys in this spec are: + +=over + +=item path + +A full path to a local filesystem directory or file for static serving. +Mutually exclusive with C<handler>. + +=item handler + +A coderef. See L</Handlers> below. Mutually exclusive with C<path>. + +=item wildcard + +If false, only exact matches will be served. If true, any requests based +on the uri will be served. eg. if C<wildcard> is false, C<'/foo/bar'> will +only match C<http://mysite.com/foo/bar> and not, say, C<http://mysite.com/foo/bar/sheep>. +If C<wildcard> is true, on the other hand, it will match. A handler can +access the path extension as described below in L</Handlers>. + +Static handlers that are directories default to wildcard true. + +=back + +The site map is always searched depth-first, in other words a more specific +uri will trump a less-specific one. + +=cut + +sub mount { + my ($self, $uri, $args) = @_; + + ref($args) eq 'HASH' or die 'third arg to mount must be a hashref'; + + my $depth; + if ($uri eq '/') { + $depth = 0; + } else { + $uri =~ s!/$!!; + my @parts = split( m!/!, $uri ); + $depth = scalar(@parts) - 1; # leading / adds one + } + + $self->{_site_map}[$depth] ||= {}; + $self->{_site_map}[$depth]{$uri} = $args; + + # we should default a static path to a wildcard mount if it's a directory + if (!exists $args->{wildcard} && exists $args->{path} && -d $args->{path}) { + $args->{wildcard} = 1; + } + + my $mount_type = exists $args->{handler} ? 'handler' : + exists $args->{path} ? 'directory' : '(unknown)'; + $self->_log( error => 'Mounted' . ($args->{wildcard} ? ' wildcard' : '') . " $mount_type at $uri" ); + + 1; +} + +=head2 start + +Actually starts the server - this will loop indefinately, or until +the process recieves a C<HUP> signal in which case it will return after servicing +any current request, or waiting for the next timeout (which defaults to 5s - see L</new>). + +=cut + +sub start { + my $self = shift; + + $__server_should_run = 1; + + # HTTP::Daemon chokes on multiple simultaneous requests + unless ($self->{leave_sig_pipe_handler_alone}) { + $self->{_old_sig_pipe_handler} = $SIG{'PIPE'}; + $SIG{'PIPE'} = 'IGNORE'; + } + + $SIG{CHLD} = 'IGNORE' if $self->{fork}; + + $self->{daemon} = $self->{daemon_class}->new( + ReuseAddr => 1, + LocalPort => $self->{port}, + LocalHost => $self->{host}, + Timeout => 5, + @{ $self->{daemon_args} }, + ) or die "Can't start daemon: $!"; + + $self->_log(error => "Server started on " . $self->{daemon}->url); + + while ($__server_should_run) { + my $conn = $self->{daemon}->accept or next; + + # if we're a forking server, fork. The parent will wait for the next request. + # TODO: limit number of children + next if $self->{fork} and fork; + while (my $req = $conn->get_request) { + + my ($submap, $match) = $self->_map_request($req); + + if ($submap) { + if (exists $submap->{path}) { + $self->_handle_static_request( $conn, $req, $submap, $match); + + } elsif (exists $submap->{handler}) { + $self->_handle_dynamic_request( $conn, $req, $submap, $match); + + } else { + $self->_send_error($conn, $req, RC_INTERNAL_SERVER_ERROR, 'Corrupt Site Map'); + } + + } else { + $self->_send_error($conn, $req, RC_NOT_FOUND, ' Not Found in Site Map'); + } + } + # should use a guard object here to protect against early exit leaving zombies + exit if $self->{fork}; + } + + + unless ($self->{leave_sig_pipe_handler_alone}) { + $SIG{'PIPE'} = $self->{_old_sig_pipe_handler}; + } + + 1; +} + +sub _handle_static_request { + my ($self, $conn, $req, $submap, $match) = @_; + + my $path = $submap->{path} . '/' . $match->{path_info}; + + if (-d $path && $match->{full_path} !~ m!/$! ) { + $conn->send_redirect( $match->{full_path} . '/', RC_SEE_OTHER ); + DEBUG && $self->_log(error => 'redirecting to path with / appended: ' . $match->{full_path}); + return; + } + + my $serve_path = -d $path ? "$path/$self->{directory_index_file}" : $path; + + if (-r $serve_path) { + my $code = $conn->send_file_response($serve_path); + $self->_log_status($req, $code); + + } elsif (-d $path && $self->{directory_indexing}) { + + my $res = $self->_render_directory($path, $match->{full_path}); + $conn->send_response( $res ); + $self->_log( access => '[' . RC_OK . "] $match->{full_path}" ); + + + } elsif (-d $path) { + $self->_send_error($conn, $req, RC_FORBIDDEN, 'Directory Indexing Not Allowed' ); + + } else { + $self->_send_error($conn, $req, RC_NOT_FOUND, 'File Not Found' ); + } +} + +sub _handle_dynamic_request { + my ($self, $conn, $req, $submap, $match) = @_; + + my $res = HTTP::Response->new; + $res->base($match->{full_path}); + + # stuff the match info into the request + $req->{mount_path} = $match->{mount_path}; + $req->{path_info} = $match->{path_info} ? '/' . $match->{path_info} : undef; + + # and some other useful bits TODO: document (and, actually, subclass HTTP::Request...) + if ($req->header('Host') =~ /^(.*):(.*)$/) { + $req->{hostname} = $1; + $req->{port} = $2; + } elsif ($req->header('Host')) { + $req->{hostname} = $req->header('Host'); + $req->{port} = $self->{daemon}->url->port; + } else { + $req->{hostname} = $self->{daemon}->url->host; + $req->{port} = $self->{daemon}->url->port; + } + + # actually call the handler + if ( my $return_code = eval { $submap->{handler}->($req, $res) } ) { + + # choose the status in this order: + # 1. if the handler died or returned false => RC_INTERNAL_SERVER_ERROR + # 2. if the handler set a code on the response object, use that + # 3. if the handler returned something that looks like a return code + # 4. RC_OK + + my $code = !$return_code ? RC_INTERNAL_SERVER_ERROR : + $res->code ? $res->code : + $return_code >= 100 ? $return_code : RC_OK; + + $res->code($code); + + # default mime type to text/html + $res->header( 'Content-Type' ) || $res->header( 'Content-Type', 'text/html' ); + + if ($res->is_success) { + $conn->send_response( $res ); + $self->_log( access => "[$code] $match->{full_path}" ); + + } elsif ($res->is_error) { + # should send user content and use $@ if provided + $self->_send_error( $conn, $req, $res->code, $res->message ); + + } elsif ($res->is_redirect) { + if (UNIVERSAL::can($res->{target_uri}, 'path')) { + my $target = $res->{target_uri}->path; + + if ($target !~ m!^/!) { + # prepend dirname of original request + $match->{full_path} =~ m!^(.*/)! and + $target = $1 . $target; + } + $conn->send_redirect($target, $code); + $self->_log( access => "[$code] Redirecting to " . $target ); + } else { + $self->_send_error($conn, $req, RC_INTERNAL_SERVER_ERROR, + 'Handler Tried to Redirect Without Setting Target URI'); + } + + } else { + $self->_send_error($conn, $req, + RC_NOT_IMPLEMENTED, + 'Handler Returned an Unimplemented Response Code: ' . $code); + } + } else { + $self->_send_error($conn, $req, RC_INTERNAL_SERVER_ERROR, 'Handler Failed'); + } + + 1; +} + +sub _render_directory { + my ($self, $path, $uri ) = @_; + + my $res = HTTP::Response->new( RC_OK ); + $res->header( 'Content-type', 'text/html' ); + + $res->add_content(<<END_HEADER); +<html> +<head> +<title>Directory for $uri</title> +</head> +<body> +<h1>Directory for $uri</h1> +<blockquote><pre> +<a href="..">.. (Parent directory)</a> +END_HEADER + + $res->add_content("<a href=\"$_\">$_</a>\n") for map {s!.*/!!; $_} sort glob "$path/*"; + + $res->add_content(<<END_FOOTER); +</pre></blockquote> +</body> +</html> +END_FOOTER + + return $res; +} + +sub _send_error { + my ($self, $conn, $req, $code, $text) = @_; + + $conn->send_error($code, $text); + + $self->_log_status($req, $code, $text); +} + +sub _log_status { + my ($self, $req, $code, $text) = @_; + + if ($code == RC_OK || $code == RC_UNAUTHORIZED || $code == RC_NOT_FOUND) { + $self->_log( access => "[$code] " . $req->uri->path ); + } + + $self->_log( error => "[$code] [" . $req->uri->path . '] ' . ($text || status_message($code)) ) + unless $code == RC_OK; +} + +# this is not the best data structure for a complex site map, but it's +# easy to insert and query (although very hard to move things around). +# basically for every path depth (ie. number of /) there is a hash of +# full paths and their associated handler and meta-data. + +# this would be an obvious performance point if you wanted to use this +# for actual serving. + +sub _map_request { + my ($self, $request) = @_; + + my $map = $self->{_site_map}; + + my $uri = $request->uri->path; + + my @parts = split( m!/!, $uri ); + + my $depth = scalar(@parts) - 1; + # the test is reall for $uri eq '/', but an integer comparison is faster + $depth = 0 if $depth == -1; + my $match_depth = $depth; + + while ($match_depth >= 0) { + + my $mount_path = '/' . join('/', @parts[1..$match_depth]); + + if ($map->[$match_depth] && exists $map->[$match_depth]{$mount_path}) { + + # if we find a depth-first match, but it's not flagged as a wildcard + # mount, then don't match + if ($match_depth != $depth && !$map->[$match_depth]{$mount_path}{wildcard}) { + return; + } + + return( + $map->[$match_depth]{$mount_path}, + { + full_path => $uri, + mount_path => $mount_path, + path_info => join('/', @parts[$match_depth+1..$depth]), + }, + ); + } + + $match_depth--; + } +} + +=head2 add_type + +The mime-type of static files is automatically determined by L<LWP::MediaTypes>. You +can add any types it doesn't know about via this method. + +The first argument is the mime type, all subsequent arguments form a list of +possible file extensions for that mime type. See L<LWP::MediaTypes> for more info. + +=cut + +# Improve LWP::MediaTypes' mime-type knowledge. +LWP::MediaTypes::add_type('image/png' => qw(png)); +LWP::MediaTypes::add_type('text/css' => qw(css)); +LWP::MediaTypes::add_type('text/javascript' => qw(js)); + +sub add_type { + my ($self, @args) = @_; + + LWP::MediaTypes::add_type(@args); +} + +sub _log { + my ($self, $log_key, $text) = @_; + + $self->{"${log_key}_log"}->print( '[' . localtime() . "] [$$] ", $text, "\n" ); +} + + +1; # Magic true value required at end of module +__END__ + +=head1 Handlers + +When a mounted handler codred matches a requested url, the sub is called with two +arguments in C<@_>, first a request object then a response object. + +=head2 Request + +The request object is an instance of L<HTTP::Request> with two extra properties: + +=over + +=item C<$req-E<gt>{mount_path}> + +The mounted path that was matched. This will always be identical to C<$req->uri->path> +for non-wildcard mounts. + +=item C<$req-E<gt>{path_info}> + +Using nomenclature from L<CGI.pm>, any extra path (or rather, uri) info after the matched C<mount_path>. +This will always be empty for non-wildcard mounts. + +=back + +The documentation for L<HTTP::Request> will be of use for extracting all the other +useful information. + +=head2 Response + +The response object is an instance of L<HTTP::Response>. The useful operations (which +you can learn how to do from the L<HTTP::Response> docs) are setting headers, +adding content and setting the http status code. + +=head2 Response Headers + +The C<Content-type> header defaults to C<text/html> unless your handler sets it to +something else. The C<Content-length> header is set for you. + +=head2 Redirection + +If you set the response code to a redirect code, you need to set a C<{target_uri}> property on the +request object to an instance of a C<URI::http> object reflecting the uri you want to redirect to +(either fully qualified or relative to the directory of the requested url). There are examples +in the test file C<t/serving.t> in this module's distribution. + +This is weak because we're breaking encapsulation by assuming it's ok to stuff an extra variable +into the response object (just as we are to propogate the C<path_info> property). It does in fact +work fine and is unlikely to ever break, but a future version (prior to 1.0.0) of this module will +replace this behavior with a subclassed L<HTTP::Response> and appropriate setter/getter methods. + +=head2 Handler Return + +The handler sub must return true for a normal response. The actual http response +is determined as follows: + + 1. if the handler died or returned false => RC_INTERNAL_SERVER_ERROR (ie. 500) + 2. if the handler set a code on the response object, use that + 3. if the handler returned something that looks like a return code + 4. RC_OK (ie. 200) + +=head1 DEBUGGING + +If an envronment variable DEBUG is set (to something Perl considers true) there will +be extra logging to C<error_log>. + +=head1 DEPENDENCIES + +L<LWP> +L<Test::More> +L<version> + +=head1 HISTORY + +Over the past few years I've spent quite a bit of time noodling about with Ruby +based web code - whether Rails or super cool continuation stuff - and it's always +easy to get a prototype up and serving thanks to WEBrick (the pure-Ruby server +that's part of the standard Ruby distribution). I've never found it quite as easy +to throw together such a prototype in Perl, hence YASHDM (yet another simple http +daemon module). + +HTTP::Server::Brick is not a clone of WEBrick - it's "in the style of" WEBrick like +those movies in the discount VHS bin are "in the style of Lassie": The good guys +get saved, the bad guys get rounded up, but the dog's never quite as well trained... + +To be more fair, I have just taken the ideas I have used (and liked) when building +prototypes with WEBrick and implemented them in (what I hope is) a Perlish way. + + +=head1 BUGS AND LIMITATIONS + +=over + +=item It's version 0.1.0 - there's bound to be some bugs! + +=item The tests fail on windows due to forking limitations. I don't see any reason why the server itself won't work but I haven't tried it personally, and I have to figure out a way to test it from a test script that will work on Windows. + +=item In forking mode there is no attempt to limit the number of forked children - beware of forking yourself ;) + +=item No attention has been given to propagating any exception text into the http error (although the exception/die message will appear in the error_log). + +=item Versions 1.02 and earlier of HTTP::Daemon::SSL has a feature/documentation conflict where it will never timeout. This means your server won't respond to a HUP signal until the next request is served. Version 1.03_01 (developer release) and later do not have this issue. + +=back + +If you want to check out the latest development version of HTTP::Server::Brick +you can do so from my L<CVS Server|http://cvs.pumptheory.com/viewcvs/viewcvs.cgi/perl/HTTP-Server-Brick/>. + +Please report any bugs or feature requests to +C<bug-http-server-brick@rt.cpan.org>, through the web interface at +L<http://rt.cpan.org> or via email to the author. + +=head1 SEE ALSO + +CPAN has various other modules that may suit you better. Search for HTTP::Server or HTTP::Daemon. +L<HTTP::Daemon>, L<HTTP::Daemon::App> and L<HTTP::Server::Simple> spring to mind. + + +=head1 AUTHOR + +=over + +=item Original version by: Mark Aufflick C<< <mark@aufflick.com> >> L<http://mark.aufflick.com/> + +=item SSL and original forking support by: Mark Aufflick C<< <mark@aufflick.com> >>. + +=item Maintained by: Mark Aufflick + +=back + +=head1 LICENCE AND COPYRIGHT + +Copyright (c) 2007, Mark Aufflick C<< <mark@aufflick.com> >>. +Portions Copyright (c) 2007, Hans Dieter Pearcey C<< <hdp@pobox.com> >> + +All rights reserved. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. See L<perlartistic>. + + +=head1 DISCLAIMER OF WARRANTY + +BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER +EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE +ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH +YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL +NECESSARY SERVICING, REPAIR, OR CORRECTION. + +IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE +LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, +OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE +THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. @@ -1,6 +1,7 @@ package INF; use INF::APC; use INF::DSRx020; +use INF::ILO; #$infs = [ @@ -30,6 +31,9 @@ sub new ($;$) { elsif ( $inf->{inf_type} eq 'apc' ) { return INF::APC->new($inf); } + elsif ( $inf->{inf_type} eq 'ilo' ) { + return INF::ILO->new($inf); + } else { return undef; } diff --git a/INF/ILO.pm b/INF/ILO.pm new file mode 100644 index 0000000..9af27c4 --- /dev/null +++ b/INF/ILO.pm @@ -0,0 +1,401 @@ +#!/usr/bin/env perl + +IO::Socket::SSL::set_ctx_defaults( SSL_verify_mode => SSL_VERIFY_NONE ); + +package INF::ILO; + +use HTTP::Daemon::SSL; +use HTTP::Server::Brick; +use HTTP::Status; + +use IO::Socket::SSL qw(); +use HTML::TreeBuilder; +use HTTP::Request::Common; +use LWP::UserAgent; +use URI::Escape; +use File::Temp qw/ tempfile tempdir /; +use XML::Simple; +use Data::Dumper; +use JSON::PP; + +sub read_file($) { + my ($name) = @_; + + my $fh = new IO::File "<" . $name; + local $/; + my $guts = $fh->getline; + $fh->close; + undef $fh; + + return $guts; +} + +sub setup_port_proxy($$$) { + my ( $local_port, $remote_host, $remote_port ) = @_; + + my $child = fork(); + + print STDERR "balance ", + join( + ' ', + ( + "balance", "-d", "-f", "127.0.0.1", $local_port, + $remote_host . ":" . $remote_port + ) + ), + "\n"; + + if ( $child == 0 ) { + + exec( "balance", "-d", "-f", "-b", "127.0.0.1", $local_port, + $remote_host . ":" . $remote_port ); + print STDERR "failed to start port proxy"; + sleep(10000); + } + + print "Setup proxy $local_port -> $remote_host:$remote_port\n"; + + return $child; +} + +sub proxy($$$) { + my ( $self, $req, $res ) = @_; + + if ( $req->uri->as_string =~ /^\/html\/java_irc.html/ ) { + + $res->header( 'Content-type' => 'text/html' ); + $res->add_content( $self->{java_html} ); + $res->code(200); + + return; + + } + + if ( $req->uri->as_string =~ /^\/html\/intgapp_.*\.jar/ ) { + + $res->header( 'Content-type' => 'application/x-ms-application' ); + $res->add_content( + read_file('/usr/local/share/inf/ilo/intgapp_221.jar') ); + $res->code(200); + + return; + } + + my $proxy_req = + HTTP::Request->new( $req->method, $self->{ilo_url} . $req->uri->as_string, + [], $req->content ); + + $proxy_req->header( 'cookie' => 'sessionKey=' . $self->{skey} ); + + my $proxy_res = $self->{ua}->request($proxy_req); + + unless ( $proxy_res->is_success ) { + print STDERR "request failed - did not get 200\n"; + } + + print "URI:", $req->uri->as_string, " code ", $proxy_res->code, " type ", + $proxy_res->header('Content-type'), "\n"; + + $res->code( $proxy_res->code ); + $res->header( 'Content-type' => $proxy_res->header('Content-type') ); + + my $content = $proxy_res->content; + + if ( $req->uri->as_string =~ /^\/json\/rc_info/ ) { + + my $local_port = int( rand(30000) ) + 30000; + + $content =~ s/"rc_port":(\d+),/"rc_port":$local_port,/; + push @{ $self->{to_kill} }, + setup_port_proxy( $local_port, $self->{host}, $1 ); + + $local_port = int( rand(30000) ) + 30000; + + $content =~ s/"vm_port":(\d+),/"vm_port":$local_port,/; + push @{ $self->{to_kill} }, + setup_port_proxy( $local_port, $self->{host}, $1 ); + + } + + $res->add_content($content); + +} + +sub login($) { + my $self = shift; + + my $post = POST( $self->{ilo_url} . '/json/login_session' ); + my $json = + '{"method":"login","user_login":"' + . $self->{user} + . '","password":"' + . $self->{password} . '"}'; + + $post->header( 'Content-Type' => 'application/json' ); + $post->header( 'Content-Length' => length($json) ); + $post->content($json); + + #my $get = GET( $self->{ilo_url}."/html/login.html" ); + + my $res = $self->{ua}->request($post); + + unless ( $res->is_success ) { + print STDERR "Login failed - did not get 200\n"; + + print Dumper($res); + + $self->{skey} = undef; + return -1; + } + + my $json = decode_json( $res->content ); + + $self->{skey} = $json->{session_key}; + + # print "Session key ".$self->{skey}."\n"; + + return 0; +} + +sub view($) { + my $self = shift; + + $self->login() unless defined $self->{skey}; + + my $get = GET( $self->{ilo_url} . '/html/java_irc.html?lang=en' ); + + my $res = $self->{ua}->request($get); + + unless ( $res->is_success ) { + print STDERR "IRC frequest failed - did not get 200\n"; + return -1; + } + my $content = $res->content; + + unless ( $content =~ /Netscape'\) {(.*)}[\s\n]*else if/s ) { + print STDERR "returned html doesn't look right\n"; + return -1; + } + + $content = $1; + + #$content=~ s/document.writeln\("(.*)"\);$/\1/m; + $content =~ s/^\s*document.writeln\("(.*)"\);\s*$/\1/mg; + $content =~ s/\\//g; + + $content =~ s/RCINFO1=.*$/RCINFO1="$self->{skey}"/m; + $content =~ s/RCINFO6=.*$/RCINFO6="17990"/m; + $content =~ s/RCINFOLANG=.*$/RCINFOLANG="en"/m; + $content =~ s%(archive=)(/.*)$%\1$self->{proxy_url}\2%m; + + $content = "<html><head></head><body>" . $content . "</body></html>"; + + $self->{java_html} = $content; + + my $webserver_pid = fork(); + + if ( $webserver_pid == 0 ) { + $SIG{INT} = sub { kill 'KILL', ( @{ $self->{to_kill} } ); die; }; + $SIG{TERM} = sub { kill 'KILL', ( @{ $self->{to_kill} } ); die; }; + + $self->{server}->start; + print STDERR "failed to web server"; + sleep(100000); + } + + push @{ $self->{to_kill} }, $webserver_pid; + + $SIG{INT} = sub { kill 'INT', ( @{ $self->{to_kill} } ); die; }; + $SIG{TERM} = sub { kill 'TERM', ( @{ $self->{to_kill} } ); die; }; + + system( + "appletviewer", + "-J-Djava.security.manager", + "-J-Djava.security.policy=/usr/local/share/inf/ilo/mypolicy", + "-J-Djavax.net.ssl.trustStore=/usr/local/share/inf/ilo/server.jks", + $self->{proxy_url} . "/html/java_irc.html" + ); + + kill 'TERM', ( @{ $self->{to_kill} } ); +} + +sub get_host_power($) { + my ($self) = @_; + + $self->login() unless defined $self->{skey}; + + my $get = GET( $self->{ilo_url} . '/json/host_power' ); + + $get->header( 'cookie' => 'sessionKey=' . $self->{skey} ); + + my $res = $self->{ua}->request($get); + + unless ( $res->is_success ) { + print STDERR " get host power - did not get 200\n"; + return undef; + } + + my $state = decode_json $res->content; + + return $state->{'hostpwr_state'}; + +} + +sub set_host_power($$) { + my ( $self, $what ) = @_; + + $self->login() unless defined $self->{skey}; + + my $post = POST( $self->{ilo_url} . '/json/host_power' ); + my $json = + '{"method":"' . $what . '","session_key":"' . $self->{skey} . '"}'; + $post->header( 'Content-Type' => 'application/json' ); + $post->header( 'Content-Length' => length($json) ); + $post->content($json); + $post->header( 'cookie' => 'sessionKey=' . $self->{skey} ); + + my $res = $self->{ua}->request($post); + + unless ( $res->is_success ) { + print STDERR " $what - did not get 200\n"; + return 0; + } + + return 1; +} + +sub cold_boot($) { + my $self = shift; + return $self->set_host_power('system_coldboot'); +} + +sub reset($) { + my $self = shift; + return $self->set_host_power('system_reset'); +} + +sub off($) { + my $self = shift; + if ( $self->get_host_power =~ /ON/i ) { + return $self->set_host_power('hold_power_button'); + } + return 1; +} + +sub on($) { + my $self = shift; + if ( $self->get_host_power =~ /OFF/i ) { + return $self->set_host_power('press_power_button'); + } + return 1; +} + +sub port_on($$) { + my $self = shift; + return $self->on(); +} + +sub port_off($$) { + my $self = shift; + return $self->off(); +} + +sub port_cycle($$) { + my $self = shift; + return $self->cold_boot(); +} + +sub port_state_get_no_cache($$) { + my $self = shift; + return $self->get_host_power(); +} + +sub port_state_get($$) { + my $self = shift; + return $self->get_host_power(); +} + +sub port_name_get($$) { + my $self = shift; + return $self->{name}; +} + +sub name_get($) { + my $self = shift; + return $self->{name}; +} + +sub pdu_load_get($) { + return "N/A"; +} + +sub psu_status($) { + return "N/A"; +} + +sub port_count($) { + return 1; +} + +sub port_id_get_by_number($$) { + return "K0"; +} + +sub new ($;$) { + my ( $class, $parm ) = @_; + my $self; + + $self->{ua} = my $ua = LWP::UserAgent->new; + + $self->{host} = $parm->{host} || "127.0.0.1"; + + $self->{user} = $parm->{user} || "Administrator"; + $self->{password} = $parm->{password} || ""; + + $self->{name} = $parm->{name} || $self->{host}; + + $self->{ilo_url} = $parm->{ilo_url} + || 'https://' . $self->{host}; + $self->{userid} = undef; + + $self->{ua}->ssl_opts( + SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE, + verify_hostname => 0, + ); + + my + + $local_port = int( rand(30000) ) + 30000; + + $self->{proxy_url} = 'https://127.0.0.1:' . $local_port; + + $self->{server} = HTTP::Server::Brick->new( + port => $local_port, + daemon_class => 'HTTP::Daemon::SSL', + daemon_args => [ + LocalAddr => '127.0.0.1', + SSL_key_file => '/usr/local/share/inf/ilo/server.key', + SSL_cert_file => '/usr/local/share/inf/ilo/server.crt', + ], + ); + $self->{server}->mount( + '/' => { + handler => sub { + my ( $req, $res ) = @_; + + $self->proxy( $req, $res ); + 1; + }, + wildcard => 1, + } + ); + + $self->{skey} = undef; + $self->{to_kill} = []; + + return bless $self, $class; + +} + +1; + @@ -1,12 +1,16 @@ install: mkdir -p /usr/local/share/inf/mibs/compiled mkdir -p /usr/local/share/inf/INF + mkdir -p /usr/local/share/inf/HTTP/Server mkdir -p /usr/local/share/inf/avocent + mkdir -p /usr/local/share/inf/ilo install -m 755 inf.pl /usr/local/bin/inf + install -m 644 HTTP/Server/Brick.pm /usr/local/share/inf/HTTP/Server/ install -m 644 INF.pm /usr/local/share/inf/ install -m 644 INF/INF.pm /usr/local/share/inf/INF install -m 644 INF/APC.pm /usr/local/share/inf/INF install -m 644 INF/DSRx020.pm /usr/local/share/inf/INF + install -m 644 INF/ILO.pm /usr/local/share/inf/INF install -m 644 mibs/PowerNet-MIB.mib /usr/local/share/inf/mibs/ install -m 644 mibs/RFC1155-SMI.mib /usr/local/share/inf/mibs/ install -m 644 mibs/RFC-1212.mib /usr/local/share/inf/mibs/ @@ -24,3 +28,10 @@ install: install -m 644 avocent/avmWin32Lib.jar /usr/local/share/inf/avocent/ install -m 644 avocent/jpcscdll.jar /usr/local/share/inf/avocent/ install -m 644 avocent/jpcscso.jar /usr/local/share/inf/avocent/ + install -m 644 ilo/certs /usr/local/share/inf/ilo/ + install -m 644 ilo/intgapp_221.jar /usr/local/share/inf/ilo/ + install -m 644 ilo/mypolicy /usr/local/share/inf/ilo/ + install -m 644 ilo/server.cnf /usr/local/share/inf/ilo/ + install -m 644 ilo/server.crt /usr/local/share/inf/ilo/ + install -m 644 ilo/server.jks /usr/local/share/inf/ilo/ + install -m 644 ilo/server.key /usr/local/share/inf/ilo/ diff --git a/ilo/certs b/ilo/certs new file mode 100755 index 0000000..4b4e262 --- /dev/null +++ b/ilo/certs @@ -0,0 +1,38 @@ +#!/bin/bash + +rm -f server.jks server.key server.csr server.crt server.cnf + +cat << EOF > server.cnf + +[req] +distinguished_name = req_distinguished_name +x509_extensions = v3_req +prompt = no + +[ req_distinguished_name ] +commonName = localhost + +[v3_req] +subjectKeyIdentifier = hash +authorityKeyIdentifier = keyid,issuer +basicConstraints = CA:TRUE +subjectAltName = @alt_names + +[alt_names] +DNS.1 = localhost +IP.1 = 127.0.0.1 + +EOF + + + +#openssl genrsa -out server.key 1024 +#openssl req -config server.cnf -new -key server.key -out server.csr +#openssl x509 -req -days 3650 -in server.csr -signkey server.key -out server.crt + +openssl req -x509 -nodes -days 3650 -newkey rsa:1024 -keyout server.key -out server.crt -config server.cnf + +yes | keytool -import -v -trustcacerts -alias 127.0.0.1 -file server.crt -keystore server.jks -keypass changeit -storepass changeit + + + diff --git a/ilo/intgapp_221.jar b/ilo/intgapp_221.jar Binary files differnew file mode 100644 index 0000000..c18f4ab --- /dev/null +++ b/ilo/intgapp_221.jar diff --git a/ilo/mypolicy b/ilo/mypolicy new file mode 100644 index 0000000..e945c25 --- /dev/null +++ b/ilo/mypolicy @@ -0,0 +1,7 @@ +grant { + permission java.net.SocketPermission "localhost", "connect, accept ,resolve, listen"; + permission java.util.PropertyPermission "java.io.tmpdir","read"; + permission java.io.FilePermission "/tmp/-", "read, write"; + permission java.io.FilePermission "/tmp", "read, write"; + permission java.lang.RuntimePermission "loadLibrary.*"; +}; diff --git a/ilo/server.cnf b/ilo/server.cnf new file mode 100644 index 0000000..fd38814 --- /dev/null +++ b/ilo/server.cnf @@ -0,0 +1,19 @@ + +[req] +distinguished_name = req_distinguished_name +x509_extensions = v3_req +prompt = no + +[ req_distinguished_name ] +commonName = localhost + +[v3_req] +subjectKeyIdentifier = hash +authorityKeyIdentifier = keyid,issuer +basicConstraints = CA:TRUE +subjectAltName = @alt_names + +[alt_names] +DNS.1 = localhost +IP.1 = 127.0.0.1 + diff --git a/ilo/server.crt b/ilo/server.crt new file mode 100644 index 0000000..998ba96 --- /dev/null +++ b/ilo/server.crt @@ -0,0 +1,14 @@ +-----BEGIN CERTIFICATE----- +MIICEjCCAXugAwIBAgIJALIh/DebfUKPMA0GCSqGSIb3DQEBBQUAMBQxEjAQBgNV +BAMTCWxvY2FsaG9zdDAeFw0xNTA2MDUxMDI3NDFaFw0yNTA2MDIxMDI3NDFaMBQx +EjAQBgNVBAMTCWxvY2FsaG9zdDCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEA +qovkL5zBHilo+a9dHIWfTYE2IQzFluyKv7sTHO3E0g91gbIpKkqdtHZ0TjZMU+Gr +/2q5bWmXRYJUAHNezzKLHDFTWjMJ8fQkjg9+82gMYMiecPrbDtaZSWH8ZQf0RWjN +XD5oV/JOl5DEsaI48xiiIuofdr1SwUvVlyfE1AhqoRECAwEAAaNsMGowHQYDVR0O +BBYEFPBsC/4d9RfwGvMo4peoXHvlBMp6MB8GA1UdIwQYMBaAFPBsC/4d9RfwGvMo +4peoXHvlBMp6MAwGA1UdEwQFMAMBAf8wGgYDVR0RBBMwEYIJbG9jYWxob3N0hwR/ +AAABMA0GCSqGSIb3DQEBBQUAA4GBAGS0FTrKSY7QtrLAufONRsqWkY3plSf/Cf0O +6MQbcQIFcu9clsj1yOcdrMJe/xd1Jhyfu1KAOIIVbif/hPP/oxn8aiT6ibCKCTTq +TInk38NwGtnZ7SQDBNL8JMCpTChDSgkdggU3PeIQip93MR0Yfhv7lePdqAD0Jdig +wFBte97D +-----END CERTIFICATE----- diff --git a/ilo/server.jks b/ilo/server.jks Binary files differnew file mode 100644 index 0000000..5460fa4 --- /dev/null +++ b/ilo/server.jks diff --git a/ilo/server.key b/ilo/server.key new file mode 100644 index 0000000..1938bed --- /dev/null +++ b/ilo/server.key @@ -0,0 +1,16 @@ +-----BEGIN PRIVATE KEY----- +MIICdgIBADANBgkqhkiG9w0BAQEFAASCAmAwggJcAgEAAoGBAKqL5C+cwR4paPmv +XRyFn02BNiEMxZbsir+7ExztxNIPdYGyKSpKnbR2dE42TFPhq/9quW1pl0WCVABz +Xs8yixwxU1ozCfH0JI4PfvNoDGDInnD62w7WmUlh/GUH9EVozVw+aFfyTpeQxLGi +OPMYoiLqH3a9UsFL1ZcnxNQIaqERAgMBAAECgYAzTTVs5RhqfEZppUi7Ba7v34hq +1K6zQaBTIHEVaKimD6RnSTJ82EksOd2ukULQkLfucyooMXUhoZynLg09ApU5fh92 +CXFa4R9JjHlIyqw1nJb9L2F6q+WYMiycCLIHBhlVjjsIb/ZyJWOc8x6Ad1CPKlZx +i5tilaj5YYoEgoi24QJBANEnbnZE94NVN4Rck6TuECtNNDdQsx3K2GMHYxlQk+dm +Yr/yMH1Tn56OEHR+m6xhVDLiV5Ov9x7x64mLI9E1JD0CQQDQvsLSGZAbiy4v4s4+ +uq9ZB98Aly/+gpqNm4Hm+iE7liSjW/de+JqOH27I3LUACwO2NHmK3FcBL2pYZWXG +RPllAkAfjnN8JKuzhQf7UHx2RfTqk5ttPR/JPvGm/1ZUW3P1Vd1QWJo4ToWmxoh1 +CyUxvP2XL89G2SXP5XBEMFoXFo2BAkB/twb5hrxdrcT/dVPcm1mnLiKpeNbbb8rh +svBCgm0MyOr3q8/ook/lfqPIbwiq0xJdSzPF2tO8nOcC2F7xdMflAkEAxTqQimce +wkc4DAzKTuwq7vtogTakOglVZxNdYq0wQ9fPCjhpaMOIEHGCnu3Ii8ay1CnPHYpD +8+W8jck6EITNCA== +-----END PRIVATE KEY----- @@ -85,7 +85,7 @@ sub thing($$$$) { $i = $wait if ( ( defined $looks ) and ( not( $s =~ /Pending/ ) ) - and ( $s =~ /$looks/ ) ); + and ( $s =~ /$looks/i ) ); print "Outlet is $s\n"; $i++; } until ( ( $i > $wait ) |