trunk/bin/cpe-queue.pl

#!/usr/bin/perl -w

# cpe-queue.pl
#
# 11/12/2007 10:03:53 PM CET  <>

use strict;

use lib './lib';
use CWMP::Queue;
use Getopt::Long;
use File::Slurp;

my $debug = 1;
my $protocol_dump = 0;
my $list = 0;

GetOptions(
        'debug+' => \$debug,
        'protocol-dump!' => \$protocol_dump,
        'list!' => \$list,
);

die "usage: $0 CPE_id [--protocol-dump]\n" unless @ARGV;

foreach my $id ( @ARGV ) {

        $id =~ s!^.*queue/+!!;
        $id =~ s!/+$!!; #!

        die "ID isn't valid: $id\n" unless $id =~ m/^\w+$/;

        my $q = CWMP::Queue->new({ id => $id, debug => $debug });


        if ( $protocol_dump ) {

                warn "generating dump of xml protocol with CPE\n";

                $q->enqueue( 'GetRPCMethods' );

                $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ] );
                $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.', 1 ] );

                $q->enqueue( 'GetParameterValues', [
                        'InternetGatewayDevice.DeviceInfo.SerialNumber',
                        'InternetGatewayDevice.DeviceInfo.VendorConfigFile.',
                        'InternetGatewayDevice.DeviceInfo.X_000E50_Country',
                ] );
                $q->enqueue( 'SetParameterValues', {
                        'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'test provision',
        #               'InternetGatewayDevice.DeviceInfo.X_000E50_Country' => 1,
                });

                $q->enqueue( 'Reboot' );

        }

        if ( $list ) {

                warn "list all jobs for $id\n";

                my @active = ();
                my @queued = ();
                my $hostname = $q->dq->gethostname();

                sub wanted {
                  my ($visitcontext, $job) = @_;

                  my $data = $job->get_data_path();
                  my $nbytes = $job->get_data_size_bytes();
                  my $timet = $job->get_time_submitted_secs();
                  my $hname = $job->get_hostname_submitted();
                  my $jobid = $job->{jobid};

                  my $text = sprintf (
                                        "%s (%d bytes)\n  Submitted: %s on %s\n",
                                        $jobid, $nbytes, scalar localtime $timet, $hname);

                        $text .= read_file( $data ) || die "can't open $data: $!";

                  if ($job->{active_pid})
                  {
                        if ($hostname eq $job->{active_host}
                                && !kill (0, $job->{active_pid}))
                        {
                          $text = sprintf (
                                        "(dead lockfile)\n  %s",
                                        $text);
                        }
                        else {
                          $text = sprintf (
                                        "(pid: %d\@%s)\n  %s",
                                        $job->{active_pid}, $job->{active_host}, $text);
                        }

                        push (@active, $text);
                  }
                  else {
                        push (@queued, $text);
                  }

                  $job->finish();
                }

                $q->dq->visit_all_jobs(\&wanted, undef);
                printf "Jobs: active: %d  queued: %d\n",
                                scalar @active, scalar @queued;
                
                print "Active jobs [", scalar @active, "]\n",join("\n\n", @active) if @active;
                print "Queued jobs [", scalar @queued, "]\n",join("\n\n", @queued) if @queued;

        } else {

                warn "injecting some tests commands\n";

                $q->enqueue( 'GetRPCMethods' );

#               $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] );

                $q->enqueue( 'GetParameterValues', [
                'InternetGatewayDevice.',
                ]);

#               $q->enqueue( 'GetParameterNames', [ '.ExternalIPAddress', 1 ] );

                $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.', 1 ] );
#               $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.', 1 ] );
#               $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceConfig.', 1 ] );
#               $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.ManagementServer.', 1 ] );
#               $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.Services.', 1 ] );
#               $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] );

                $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.', 0 ] );
                $q->enqueue( 'GetParameterValues', [
                        'InternetGatewayDevice.',
                ]);

                $q->enqueue( 'GetParameterAttributes', [
                        'InternetGatewayDevice.DeviceInfo.SerialNumber',
                        'InternetGatewayDevice.DeviceInfo.SoftwareVersion',
                ]);

#               $q->enqueue( 'SetParameterAttributes', [ '
        }

}
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	'InternetGatewayDevice.DeviceInfo.SoftwareVersion',
142	]);
143
144	# $q->enqueue( 'SetParameterAttributes', [ '
145	}
146
147	}