package RDA::Web;

# $Id: Web.pm,v 1.13 2008/02/25 14:55:26 mschenke Exp $
# ARCS: $Header: /home/cvs/repository/RDA_4/src/scripting/lib/RDA/Web.pm,v 1.13 2008/02/25 14:55:26 mschenke Exp $
#
# Change History
# 20080225  MSC  Change the copyright notice.

=head1 NAME

RDA::Web - Package Used to Manage Web Access.

=head1 SYNOPSIS

require RDA::Web;

=head1 DESCRIPTION

The following method is available:

=cut

use strict;

BEGIN
{ use Exporter;
  use File::Spec;
  use Socket;
}

# Define the global public variables
use vars qw($VERSION);
$VERSION = sprintf("%d.%02d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/);

# Define the global constants
my $EOL = "\015\012";
my $TTL = "<ACRONYM title='Remote Diagnostic Agent'>RDA</ACRONYM> Viewer";

my %tb_typ = (
  bz2  => 'application/x-bzip2',
  css  => 'text/css',
  gz   => 'application/x-gzip',
  htm  => 'text/html',
  html => 'text/html',
  tar  => 'application/x-tar',
  tgz  => 'application/x-gzip',
  txt  => 'text/text',
  z    => 'application/x-compress',
  zip  => 'application/zip',
  );

# Report the module version number
sub Version
{ $VERSION;
}

=head2 S<RDA::Web::server($agent[,$port],password)>

This method starts a basic Web server to review the reports in the report
directory structure. It uses basic authentication to restrict page access. If
a password is not provided, then the Web server is not started. The user and
password are displayed at server startup.

The start page can be accessed using the following URL:

  http://<host>:<port>/display/

By default, port 8778 is used. You can specify an alternative port as an
argument.

=cut

sub server
{ my $agt = shift;
  my ($acl, $cln, $dbg, $dft, $rpt, %tb_cln);

  # Initialisation
  $rpt = $agt->get_setting('RPT_DIRECTORY', 'output');
  $dbg = $agt->get_setting('RDA_DEBUG');
  $dft = $agt->get_setting('RPT_GROUP', 'RDA').'__start.htm';
  $dft = lc($dft) unless $agt->get_setting('RDA_CASE', 1);

  # Treat the arguments
  my $prt = 8778;
  my $pwd = '';
  foreach my $arg (@_)
  { if ($arg =~ m/\D/)
    { $pwd = $arg;
    }
    else
    { $prt = $arg;
    }
  }
  return 0 unless $pwd;
  $acl->{'rda'} = $pwd;

  # Start the service
  socket(SRV, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
    || die "socket: $!";
  setsockopt(SRV, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
    || die "setsockopt: $!";
  bind(SRV, sockaddr_in($prt, INADDR_ANY))
    || die "bind: $!";
  listen(SRV, SOMAXCONN)
    || die "listen: $!";
  _dsp_msg("server started on port $prt: rda/$pwd");

  # Treat the web requests
  while ($cln = accept(CLN, SRV))
  { my ($adr, $htp, $nam, $req, $url);

    local $SIG{'PIPE'} = 'IGNORE';

    # Get the client address
    if (exists($tb_cln{$cln}))
    { ($nam, $adr, $prt) = @{$tb_cln{$cln}};
    }
    else
    { ($prt, $adr) = sockaddr_in($cln);
       $nam = gethostbyaddr($adr, AF_INET);
       $adr = inet_ntoa($adr);
       $nam = $adr unless defined($nam);
       $tb_cln{$cln} = [$nam, $adr, $prt];
    }

    # Get the HTTP header
    $url = '';
    $req = {};
    binmode(CLN);
    while (<CLN>)
    { print "$$/Header: $_" if $dbg;
      s/[\n\r]+//;
      if (m#^([A-Z][A-Za-z\-]*):\s+(.*)$#)
      { $req->{$1} = $2;
      }
      elsif (m#^GET\s+(.*)\s+HTTP/(\d\.\d)$#)
      { ($url, $htp) = ($1, $2);
      }
      elsif (m#^$#)
      { last;
      }
    }
    _dsp_msg("Request from $nam [$adr] at port $prt:\n  $url");

    # Treat the request
    if (_need_authen($req, $acl))
    { # Request an authentication
      print CLN "HTTP/1.0 401 Authentication required$EOL",
        "WWW-Authenticate: basic realm=\"RDA Viewer\"$EOL",
        "Content-Type: text/html; charset=UTF-8$EOL$EOL",
        "<H1 style='color:Red'>$TTL</H1>$EOL",
        "<H2>HTTP Code 401: Authentication required</H2>$EOL";
    }
    elsif ($url =~ s#^/display/##)
    { my ($buf, $fil, $lgt, $suf, $typ);

      $url = $dft unless $url;
      $fil = File::Spec->catfile($rpt, split(/\//, $url));
      if ($url !~ m#^\.# && $url !~ m#\/\.# && open(FIL, "<$fil"))
      { # Determine the MIME type
        $typ = 'application/octet-stream';
        if ($fil =~ m/\.([a-z][a-z0-9]*)$/i)
        { $suf = lc($1);
          if (exists($tb_typ{$suf}))
          { $typ = $tb_typ{$suf} if exists($tb_typ{$suf});
          }
          elsif ($suf eq 'dat')
          { $lgt = sysread(FIL, $buf, 4096);
            $typ = 'text/plain' unless $buf =~ m/[^\b\f\n\r\t\040-\176]/
          }
        }

        # Generate the page
        print CLN "HTTP/1.0 200 OK$EOL",
          "Content-Type: $typ; charset=UTF-8$EOL$EOL";
        print CLN $buf if $lgt;
        while ($lgt = sysread(FIL, $buf, 4096))
        { print CLN $buf;
        }
        close(FIL);
      }
      else
      { print CLN "HTTP/1.0 404 Invalid page$EOL",
          "Content-Type: text/html; charset=UTF-8$EOL$EOL",
          "<H1 style='color:Red'>$TTL</H1>$EOL",
          "<H2>HTTP Code 404: Invalid page</H2>$EOL";
      }
    }
    else
    { print CLN "HTTP/1.0 404 Invalid request$EOL",
        "Content-Type: text/html; charset=UTF-8$EOL$EOL",
        "<H1 style='color:Red'>$TTL</H1>$EOL",
        "<H2>HTTP Code 404: Invalid request</H2>$EOL";
    }

    # Close the client socket
    close(CLN);
  }

  # Indicate that the setup must not be saved
  0;
}

# Display a log message
sub _dsp_msg
{ print "$$: @_ at ".scalar(gmtime)."\n";
}

# Validate the authentication
sub _need_authen
{ my ($req, $acl) = @_;
  my ($enc, $pwd, $str, $usr);

  # Check if an authentication is present
  return 1 unless exists($req->{'Authorization'})
    && ($req->{'Authorization'} =~ m#^Basic\s+([A-Za-z0-9+/=]*)#i)
    && (length($enc = $1) % 4) == 0;

  # Decode the authentication
  local ($^W) = 0 ;
  $enc =~ s/=+$//;              # Remove padding
  $enc =~ tr|A-Za-z0-9+/| -_|;  # Convert to uuencode
  $str = '';
  $str .= unpack('u', chr(32 + 3 * length($1) / 4).$1)
    while $enc =~ /(.{1,60})/gs;

  # Validate the authentication
  ($usr, $pwd) = split(/\:/, $str, 2);
  !exists($acl->{$usr}) || $acl->{$usr} ne $pwd;
}

1;

__END__

=head1 SEE ALSO

See also L<RDA::Agent|RDA::Agent>, L<RDA::Block|RDA::Block>,
L<RDA::Daemon|RDA::Daemon>, L<RDA::Discover|RDA::Discover>,
L<RDA::Extra|RDA::Extra>, L<RDA::Filter|RDA::Filter>,
L<RDA::Lock|RDA::Lock>, L<RDA::Log|RDA::Log>,
L<RDA::Module|RDA::Module>, L<RDA::Output|RDA::Output>,
L<RDA::Pod|RDA::Pod>, L<RDA::Profile|RDA::Profile>,
L<RDA::Remote|RDA::Remote>, L<RDA::Render|RDA::Render>,
L<RDA::Setting|RDA::Setting>, L<RDA::Upgrade|RDA::Upgrade>,
L<RDA::Value|RDA::Value>.

=head1 COPYRIGHT NOTICE

Copyright (c) 2002-2008, Oracle. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle, JD Edwards, PeopleSoft, and Siebel are registered trademarks of Oracle
Corporation and/or its affiliates. Other names may be trademarks of their
respective owners.

=cut