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
  18 GetOptions(
  19         'debug+' => \$debug,
  20         'protocol-dump!' => \$protocol_dump,
  21         'list!' => \$list,
  22 );
  23
  24 die "usage: $0 CPE_id [--protocol-dump]\n" unless @ARGV;
  25
  26 foreach my $id ( @ARGV ) {
  27
  28         $id =~ s!^.*queue/+!!;
  29         $id =~ s!/+$!!; #!
  30
  31         die "ID isn't valid: $id\n" unless $id =~ m/^\w+$/;
  32
  33         my $q = CWMP::Queue->new({ id => $id, debug => $debug });
  34
  35
  36         if ( $protocol_dump ) {
  37
  38                 warn "generating dump of xml protocol with CPE\n";
  39
  40                 $q->enqueue( 'GetRPCMethods' );
  41
  42                 $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ] );
  43                 $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.', 1 ] );
  44
  45                 $q->enqueue( 'GetParameterValues', [
  46                         'InternetGatewayDevice.DeviceInfo.SerialNumber',
  47                         'InternetGatewayDevice.DeviceInfo.VendorConfigFile.',
  48                         'InternetGatewayDevice.DeviceInfo.X_000E50_Country',
  49                 ] );
  50                 $q->enqueue( 'SetParameterValues', {
  51                         'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'test provision',
  52         #               'InternetGatewayDevice.DeviceInfo.X_000E50_Country' => 1,
  53                 });
  54
  55                 $q->enqueue( 'Reboot' );
  56
  57         }
  58
  59         if ( $list ) {
  60
  61                 warn "list all jobs for $id\n";
  62
  63                 my @active = ();
  64                 my @queued = ();
  65                 my $hostname = $q->dq->gethostname();
  66
  67                 sub wanted {
  68                   my ($visitcontext, $job) = @_;
  69
  70                   my $data = $job->get_data_path();
  71                   my $nbytes = $job->get_data_size_bytes();
  72                   my $timet = $job->get_time_submitted_secs();
  73                   my $hname = $job->get_hostname_submitted();
  74                   my $jobid = $job->{jobid};
  75
  76                   my $text = sprintf (
  77                                         "%s (%d bytes)\n  Submitted: %s on %s\n",
  78                                         $jobid, $nbytes, scalar localtime $timet, $hname);
  79
  80                         $text .= read_file( $data ) || die "can't open $data: $!";
  81
  82                   if ($job->{active_pid})
  83                   {
  84                         if ($hostname eq $job->{active_host}
  85                                 && !kill (0, $job->{active_pid}))
  86                         {
  87                           $text = sprintf (
  88                                         "(dead lockfile)\n  %s",
  89                                         $text);
  90                         }
  91                         else {
  92                           $text = sprintf (
  93                                         "(pid: %d\@%s)\n  %s",
  94                                         $job->{active_pid}, $job->{active_host}, $text);
  95                         }
  96
  97                         push (@active, $text);
  98                   }
  99                   else {
 100                         push (@queued, $text);
 101                   }
 102
 103                   $job->finish();
 104                 }
 105
 106                 $q->dq->visit_all_jobs(\&wanted, undef);
 107                 printf "Jobs: active: %d  queued: %d\n",
 108                                 scalar @active, scalar @queued;
 109
 110                 print "Active jobs [", scalar @active, "]\n",join("\n\n", @active) if @active;
 111                 print "Queued jobs [", scalar @queued, "]\n",join("\n\n", @queued) if @queued;
 112
 113         } else {
 114
 115                 warn "injecting some tests commands\n";
 116
 117                 $q->enqueue( 'GetRPCMethods' );
 118
 119         #       $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] );
 120
 121         #       $q->enqueue( 'GetParameterValues', [
 122         #               'InternetGatewayDevice.',
 123         #       ]);
 124
 125         #       $q->enqueue( 'GetParameterNames', [ '.ExternalIPAddress', 1 ] );
 126
 127         #       $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.', 1 ] );
 128         #       $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.', 1 ] );
 129         #       $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceConfig.', 1 ] );
 130         #       $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.ManagementServer.', 1 ] );
 131         #       $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.Services.', 1 ] );
 132         #       $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] );
 133
 134                 $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.', 0 ] );
 135                 $q->enqueue( 'GetParameterValues', [
 136                         'InternetGatewayDevice.',
 137                 ]);
 138
 139                 $q->enqueue( 'GetParameterAttributes', [
 140                         'InternetGatewayDevice.DeviceInfo.SerialNumber',
 141                 ]);
 142
 143 #               $q->enqueue( 'SetParameterAttributes', [ '
 144         }
 145
 146 }