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