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	dpavlin	197	#!/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	dpavlin	199	use File::Slurp;
13	dpavlin	197
14	dpavlin	199	my $debug = 1;
15			my $protocol_dump = 0;
16			my $list = 0;
17	dpavlin	197
18			GetOptions(
19			'debug+' => \$debug,
20			'protocol-dump!' => \$protocol_dump,
21	dpavlin	199	'list!' => \$list,
22	dpavlin	197	);
23
24	dpavlin	216	die "usage: $0 CPE_id [--protocol-dump]\n" unless @ARGV;
25	dpavlin	197
26	dpavlin	216	foreach my $id ( @ARGV ) {
27	dpavlin	197
28	dpavlin	216	$id =~ s!^.*queue/+!!;
29			$id =~ s!/+$!!; #!
30	dpavlin	197
31	dpavlin	216	die "ID isn't valid: $id\n" unless $id =~ m/^\w+$/;
32	dpavlin	197
33	dpavlin	216	my $q = CWMP::Queue->new({ id => $id, debug => $debug });
34	dpavlin	199
35	dpavlin	197
36	dpavlin	216	if ( $protocol_dump ) {
37	dpavlin	197
38	dpavlin	216	warn "generating dump of xml protocol with CPE\n";
39	dpavlin	197
40	dpavlin	216	$q->enqueue( 'GetRPCMethods' );
41	dpavlin	197
42	dpavlin	216	$q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ] );
43			$q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.', 1 ] );
44	dpavlin	197
45	dpavlin	216	$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	dpavlin	197
55	dpavlin	216	$q->enqueue( 'Reboot' );
56	dpavlin	197
57	dpavlin	216	}
58	dpavlin	199
59	dpavlin	216	if ( $list ) {
60	dpavlin	199
61	dpavlin	216	warn "list all jobs for $id\n";
62	dpavlin	199
63	dpavlin	216	my @active = ();
64			my @queued = ();
65			my $hostname = $q->dq->gethostname();
66	dpavlin	199
67	dpavlin	216	sub wanted {
68			my ($visitcontext, $job) = @_;
69	dpavlin	199
70	dpavlin	216	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	dpavlin	199
76	dpavlin	216	my $text = sprintf (
77			"%s (%d bytes)\n Submitted: %s on %s\n",
78			$jobid, $nbytes, scalar localtime $timet, $hname);
79	dpavlin	199
80	dpavlin	216	$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	dpavlin	199	}
105
106	dpavlin	216	$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	dpavlin	199
113	dpavlin	216	} else {
114	dpavlin	199
115	dpavlin	216	warn "injecting some tests commands\n";
116	dpavlin	199
117	dpavlin	216	$q->enqueue( 'GetRPCMethods' );
118	dpavlin	199
119	dpavlin	221	# $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] );
120	dpavlin	199
121	dpavlin	221	$q->enqueue( 'GetParameterValues', [
122			'InternetGatewayDevice.',
123			]);
124	dpavlin	199
125	dpavlin	221	# $q->enqueue( 'GetParameterNames', [ '.ExternalIPAddress', 1 ] );
126	dpavlin	199
127	dpavlin	221	$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	dpavlin	216
134			$q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.', 0 ] );
135			$q->enqueue( 'GetParameterValues', [
136			'InternetGatewayDevice.',
137			]);
138	dpavlin	219
139			$q->enqueue( 'GetParameterAttributes', [
140			'InternetGatewayDevice.DeviceInfo.SerialNumber',
141	dpavlin	221	'InternetGatewayDevice.DeviceInfo.SoftwareVersion',
142	dpavlin	219	]);
143
144			# $q->enqueue( 'SetParameterAttributes', [ '
145	dpavlin	216	}
146
147	dpavlin	199	}