clients/LynuxWorks/lib/ecrc.pm

   1 #!/usr/bin/perl
   2 ################################################################################
   3 #
   4 # File:         ecrd.pm: ECR Daemon Client Library
   5 # Description:  Perl Module interface to ecrd (ECR Daemon). This is used
   6 #               by ecrc and cgi scripts to talk to ECR Daemon
   7 # Author:       Andrew@DeFaria.com
   8 # Created:      Tue Feb 15 09:40:57 PST 2005
   9 # Modified:
  10 # Language:     Perl
  11 #
  12 # (c) Copyright 2005, LynuxWorks, all rights reserved.
  13 #
  14 ################################################################################
  15 use strict;
  16 use warnings;
  17
  18 use IO::Socket;
  19
  20 package ecrc;
  21   require Exporter;
  22   @main::ISA = qw (Exporter);
  23
  24   @main::EXPORT = qw (Connect GetECRRecord Disconnect);
  25
  26   my $default_server    = (!defined $ENV {ECRDSERVER}) ? "lynx12" : $ENV {ECRDSERVER};
  27   my $default_port      = (!defined $ENV {ECRDPORT})   ? 1500     : $ENV {ECRDPORT};
  28   my $verbose           = 0;
  29   my $debug             = 0;
  30   my $command;
  31   my $ecrserver;
  32
  33   # Forwards
  34   sub ConnectToServer;
  35   sub GetServerAck;
  36   sub GetServerList;
  37   sub GetServerResponse;
  38   sub SendServerAck;
  39   sub SendServerCmd;
  40
  41   BEGIN {
  42     my $ecrcversion = "1.1";
  43
  44     # Reopen STDOUT to make sure it's clear
  45     open STDOUT, ">-" or die "Unable to reopen STDOUT\n";
  46
  47     # Set unbuffered output
  48     $| = 1;
  49   } # BEGIN
  50
  51   sub set_verbose {
  52     $verbose = 1;
  53   } # set_verbose
  54
  55   sub set_debug {
  56     $debug = 1;
  57   } # set_debug
  58
  59   sub verbose {
  60     print "@_\n" if $verbose;
  61   } # verbose
  62
  63   sub debug {
  64     print "DEBUG: @_\n" if $debug;
  65   } # debug
  66
  67   sub Connect {
  68     my $host = shift;
  69     my $port = shift;
  70
  71     my $result;
  72
  73     $host = $default_server if !defined $host;
  74     $port = $default_port   if !defined $port;
  75
  76     $ecrserver = ConnectToServer $host, $port;
  77
  78     if ($ecrserver) {
  79       verbose "Connected to $host";
  80       SendServerAck $ecrserver;
  81     } # if
  82
  83     return $ecrserver;
  84   } # Connect
  85
  86   sub Disconnect {
  87     my $msg;
  88
  89     if ($ecrserver) {
  90       if ($command eq "shutdown") {
  91         $msg = "Disconnected from server - shutdown server";
  92       } else {
  93         $command = "quit";
  94         $msg     = "Disconnected from server";
  95       } # if
  96       SendServerCmd $ecrserver, $command;
  97       GetServerAck  $ecrserver;
  98       verbose "$msg";
  99       close $ecrserver;
 100       undef $ecrserver;
 101     } # if
 102   } # Disconnect
 103
 104   sub GetECRRecord {
 105     my $ecr = shift;
 106
 107     my %fields;
 108     my @ecrs;
 109
 110     if (!$ecrserver) {
 111       verbose "Not connected to server yet!";
 112       verbose "Attempting connection to $default_server...";
 113       if (!Connect $default_server, $default_port) {
 114         print "Unable to connect to server $default_server\n";
 115         exit 1;
 116       } # if
 117     } # if
 118
 119     SendServerCmd $ecrserver, $ecr;
 120     GetServerAck  $ecrserver;
 121
 122     if ($ecr eq "\*") {
 123       @ecrs = GetServerList $ecrserver;
 124     } else {
 125       %fields = GetServerResponse $ecrserver;
 126     } # if
 127
 128    SendServerAck $ecrserver;
 129
 130     return $ecr eq "\*" ? @ecrs : %fields;
 131   } # GetECRRecord
 132
 133   END {
 134     verbose "Sending disconnect command to server";
 135     $command = "quit";
 136     Disconnect;
 137   } # END
 138
 139   sub ConnectToServer {
 140     my $host = shift;
 141     my $port = shift;
 142
 143     # create a tcp connection to the specified host and port
 144     return IO::Socket::INET->new(Proto     => "tcp",
 145                                  PeerAddr  => $host,
 146                                  PeerPort  => $port);
 147   } # ConnectToServer
 148
 149   sub SendServerAck {
 150     my $server = shift;
 151
 152     print $server "ACK\n";
 153   } # SendServerAck
 154
 155   sub GetServerAck {
 156     my $server = shift;
 157     my $srvresp;
 158
 159     while (defined ($srvresp = <$server>)) {
 160       chomp $srvresp;
 161       if ($srvresp eq "ACK") {
 162         return;
 163       } # if
 164       print "Received $srvresp from server - expected ACK\n";
 165     } # while
 166   } # GetServerAck
 167
 168   sub GetServerList {
 169     my $server = shift;
 170
 171     my @ecrs;
 172     my $srvresp;
 173
 174     while (defined ($srvresp = <$server>)) {
 175       chomp $srvresp;
 176       last if $srvresp eq "ACK";
 177       if ($srvresp =~ m/ECR.*was not found/) {
 178         return ();
 179       } else {
 180         push @ecrs, $srvresp;
 181       } # if
 182     } # while
 183
 184     return @ecrs;
 185   } # GetServerList
 186
 187   sub GetServerResponse {
 188     my $server = shift;
 189
 190     my %fields;
 191     my $srvresp;
 192
 193     while (defined ($srvresp = <$server>)) {
 194       chomp $srvresp;
 195       last if $srvresp eq "ACK";
 196       if ($srvresp =~ m/ECR.*was not found/) {
 197         return ();
 198       } else {
 199         $srvresp =~ /(^\w+):\s+(.*)/s;
 200         my $value = $2;
 201         if (defined $value) {
 202           $value =~ s/\\n/\n/g;
 203         } else {
 204           $value = "";
 205         } # if
 206         $fields {$1} = $value;
 207       } # if
 208     } # while
 209
 210     return %fields;
 211   } # GetServerResponse
 212
 213   sub SendServerCmd {
 214     my $server  = shift;
 215     my $command = shift;
 216
 217     print $server "$command\n";
 218   } # SendServerCmd
 219
 220 1;