bin/cpe-queue.pl

   1 #!/usr/bin/perl -w
   2
   3 # cpe-queue.pl
   4 #
   5 # 11/12/2007 10:03:53 PM CET  <>
   6
   7 use strict;
   8
   9 use lib './lib';
  10 use CWMP::Queue;
  11 use Getopt::Long;
  12 use File::Slurp;
  13
  14 my $debug = 1;
  15 my $protocol_dump = 0;
  16 my $list = 0;
  17 my $introspect = 0;
  18
  19 GetOptions(
  20         'debug+' => \$debug,
  21         'protocol-dump!' => \$protocol_dump,
  22         'list!' => \$list,
  23         'introspect!' => \$introspect,
  24 );
  25
  26 die "usage: $0 [...queue/]CPE_id [ --list | --introspect | --protocol-dump ]\n" unless @ARGV;
  27
  28 foreach my $id ( @ARGV ) {
  29
  30         $id =~ s!^.*queue/+!!;
  31         $id =~ s!/+$!!; #!
  32
  33         die "ID isn't valid: $id\n" unless $id =~ m/^\w+$/;
  34
  35         my $q = CWMP::Queue->new({ id => $id, debug => $debug });
  36
  37
  38         if ( $protocol_dump ) {
  39
  40                 warn "generating dump of xml protocol with CPE\n";
  41
  42                 $q->enqueue( 'GetRPCMethods' );
  43
  44                 $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ] );
  45                 $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.', 1 ] );
  46
  47                 $q->enqueue( 'GetParameterValues', [
  48                         'InternetGatewayDevice.DeviceInfo.SerialNumber',
  49                         'InternetGatewayDevice.DeviceInfo.VendorConfigFile.',
  50                         'InternetGatewayDevice.DeviceInfo.X_000E50_Country',
  51                 ] );
  52                 $q->enqueue( 'SetParameterValues', {
  53                         'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'test provision',
  54         #               'InternetGatewayDevice.DeviceInfo.X_000E50_Country' => 1,
  55                 });
  56
  57                 $q->enqueue( 'Reboot' );
  58
  59         }
  60
  61         if ( $list ) {
  62
  63                 warn "list all jobs for $id\n";
  64
  65                 my @active = ();
  66                 my @queued = ();
  67                 my $hostname = $q->dq->gethostname();
  68
  69                 sub wanted {
  70                   my ($visitcontext, $job) = @_;
  71
  72                   my $data = $job->get_data_path();
  73                   my $nbytes = $job->get_data_size_bytes();
  74                   my $timet = $job->get_time_submitted_secs();
  75                   my $hname = $job->get_hostname_submitted();
  76                   my $jobid = $job->{jobid};
  77
  78                   my $text = sprintf (
  79                                         "%s (%d bytes)\n  Submitted: %s on %s\n",
  80                                         $jobid, $nbytes, scalar localtime $timet, $hname);
  81
  82                         $text .= read_file( $data ) || die "can't open $data: $!";
  83
  84                   if ($job->{active_pid})
  85                   {
  86                         if ($hostname eq $job->{active_host}
  87                                 && !kill (0, $job->{active_pid}))
  88                         {
  89                           $text = sprintf (
  90                                         "(dead lockfile)\n  %s",
  91                                         $text);
  92                         }
  93                         else {
  94                           $text = sprintf (
  95                                         "(pid: %d\@%s)\n  %s",
  96                                         $job->{active_pid}, $job->{active_host}, $text);
  97                         }
  98
  99                         push (@active, $text);
 100                   }
 101                   else {
 102                         push (@queued, $text);
 103                   }
 104
 105                   $job->finish();
 106                 }
 107
 108                 $q->dq->visit_all_jobs(\&wanted, undef);
 109                 printf "Jobs: active: %d  queued: %d\n",
 110                                 scalar @active, scalar @queued;
 111
 112                 print "Active jobs [", scalar @active, "]\n",join("\n\n", @active) if @active;
 113                 print "Queued jobs [", scalar @queued, "]\n",join("\n\n", @queued) if @queued;
 114
 115         } elsif ( $introspect ) {
 116
 117                 $q->enqueue( 'GetRPCMethods' ); # XXX not supported by ZTE
 118
 119                 $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.', 1 ] );
 120
 121 #               $q->enqueue( 'GetRPCMethods' ); # XXX not supported by ZTE
 122
 123                 $q->enqueue( 'GetParameterValues', [
 124                 'InternetGatewayDevice.',
 125                 ]);
 126
 127
 128 #               $q->enqueue( 'GetParameterNames', [ '.ExternalIPAddress', 1 ] );
 129
 130                 $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.', 1 ] );
 131 #               $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.', 1 ] );
 132 #               $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceConfig.', 1 ] );
 133 #               $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.ManagementServer.', 1 ] );
 134 #               $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.Services.', 1 ] );
 135 #               $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] );
 136
 137                 $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.', 0 ] );
 138                 $q->enqueue( 'GetParameterValues', [
 139                         #'InternetGatewayDevice.',      # too big for ZTE
 140                         'InternetGatewayDevice.DeviceConfig.',
 141                         'InternetGatewayDevice.DeviceInfo.',
 142                         'InternetGatewayDevice.DeviceSummary',
 143                         'InternetGatewayDevice.ManagementServer.',
 144                 ]);
 145
 146                 $q->enqueue( 'GetParameterValues' => [ $_ ] ) foreach ( qw/
 147 InternetGatewayDevice.IPPingDiagnostics.
 148 InternetGatewayDevice.LANConfigSecurity.
 149 InternetGatewayDevice.LANDevice.
 150 InternetGatewayDevice.Layer2Bridging.
 151 InternetGatewayDevice.Layer3Forwarding.
 152 InternetGatewayDevice.ManagementServer.
 153 InternetGatewayDevice.QueueManagement.
 154 InternetGatewayDevice.Time.
 155 InternetGatewayDevice.UserInterface.
 156 InternetGatewayDevice.WANDevice.
 157                 / );
 158
 159                 $q->enqueue( 'GetParameterAttributes', [
 160                         'InternetGatewayDevice.DeviceInfo.SerialNumber',
 161                         'InternetGatewayDevice.DeviceInfo.SoftwareVersion',
 162                 ]);
 163
 164 #               $q->enqueue( 'SetParameterAttributes', [ '
 165
 166         } else {
 167
 168                 warn "injecting some tests commands\n";
 169
 170                 # turn on periodic reporting to ACS server
 171
 172 #               $q->enqueue( 'GetParameterValues', [ 'InternetGatewayDevice.ManagementServer.' ] );
 173                 $q->enqueue( 'SetParameterValues', {
 174                         'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'perl-cwmp provision',
 175                 } );
 176                 $q->enqueue( 'SetParameterValues', {
 177                         'InternetGatewayDevice.ManagementServer.PeriodicInformInterval' => 15, # s
 178                 } );
 179                 $q->enqueue( 'SetParameterValues', {
 180                         'InternetGatewayDevice.ManagementServer.PeriodicInformEnable' => 1,
 181                 } );
 182
 183                 $q->enqueue( 'GetParameterValues', [
 184                         'InternetGatewayDevice.ManagementServer.',
 185                         'InternetGatewayDevice.DeviceInfo.ProvisioningCode',
 186                 ] );
 187
 188         }
 189
 190 }