File Coverage

blib/lib/NBU/License.pm
Criterion Covered Total %
statement 25 169 14.7
branch 0 60 0.0
condition 0 6 0.0
subroutine 7 23 30.4
pod 0 16 0.0
total 32 274 11.6


line stmt bran cond sub pod time code
1             #
2             # Copyright (c) 2002 Paul Winkeler. All Rights Reserved.
3             # This program is free software; you may redistribute it and/or modify it under
4             # the same terms as Perl itself.
5             #
6             package NBU::License;
7              
8 1     1   8 use Date::Parse;
  1         3  
  1         153  
9              
10 1     1   7 use strict;
  1         2  
  1         37  
11 1     1   7 use Carp;
  1         2  
  1         75  
12              
13             BEGIN {
14 1     1   6 use Exporter ();
  1         97  
  1         25  
15 1     1   6 use AutoLoader qw(AUTOLOAD);
  1         2  
  1         7  
16 1     1   49 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
  1         2  
  1         197  
17 1     1   2 $VERSION = do { my @r=(q$Revision: 1.6 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
  1         8  
  1         9  
18 1         14 @ISA = qw();
19 1         1 @EXPORT = qw();
20 1         3 @EXPORT_OK = qw();
21 1         1872 %EXPORT_TAGS = qw();
22             }
23              
24             my %legit;
25             my %licenses;
26             my %featureDescriptions;
27             my %productDescriptions;
28              
29             sub new {
30 0     0 0   my $proto = shift;
31 0           my $License = { };
32              
33 0           bless $License, $proto;
34              
35 0 0         if (@_) {
36 0           my $server = shift;
37 0           my $key = shift;
38              
39              
40 0 0         if (exists($licenses{$key})) {
41 0           return $licenses{$key};
42             }
43              
44 0           $License->{KEY} = $key;
45 0           $License->{BASEKEY} = shift;
46              
47 0           $License->{FEATURES} = [];
48              
49 0           $License->{INSTALLS} = {};
50              
51 0           $licenses{$key} = $License;
52             }
53              
54 0           return $License;
55             }
56              
57             sub populate {
58 0     0 0   my $proto = shift;
59 0           my $master = shift;
60 0           my $mmOnlyP = shift;
61 0           my @masters;
62              
63 0 0         if (!defined($master)) {
64 0           @masters = NBU->masters;
65             }
66             else {
67 0           push @masters, $master;
68             }
69              
70              
71 0           for $master (@masters) {
72 0 0         next if (exists($legit{$master->name}));
73              
74 0           $legit{$master->name} = 0;
75 0 0         die "Could not open license pipe\n" unless my $pipe = NBU->cmd("bpminlicense -M ".$master->name." -nb_features -verbose |");
76 0           my $l;
77 0           my ($baseKey, $key);
78 0           my ($installHost, $installDate);
79 0           while (<$pipe>) {
80 0           chop; s/[\s]*$//;
  0            
81 0 0         if (/^[\S]+/) {
82 0 0         $l->install($installHost, $installDate) if (defined($l));
83 0           ($baseKey, $key) = split;
84 0           $l = $proto->new($master, $baseKey, $key);
85 0           next;
86             }
87 0 0         if (/^ file version[\s]+= ([\S]+)$/) {
88 0           $l->{FILEVERSION} = $1;
89 0           next;
90             }
91              
92 0 0         if (/^ time added[\s]+= ([\S]+) (.*)$/) {
93 0           $installDate = str2time($2);
94 0           next;
95             }
96 0 0         if (/^ hostname[\s]+= ([\S]+)$/) {
97 0           $installHost = NBU::Host->new($1);
98 0           next;
99             }
100              
101 0 0         if (/^ product ID[\s]+= ([\S]+) (.*)$/) {
102 0           my $id = $1;
103 0           my $description = $2;
104 0           $l->{PRODUCT} = $id;
105 0           $productDescriptions{$id} = $description;
106 0           next;
107             }
108 0 0         if (/^ serial number[\s]+= ([\S]+)$/) {
109 0           $l->{SERIALNUMBER} = $1;
110 0           next;
111             }
112 0 0         if (/^ key version[\s]+= ([\S]+)$/) {
113 0           $l->{KEYVERSION} = $1;
114 0           next;
115             }
116 0 0         if (/^ count[\s]+= ([\S]+)$/) {
117 0           $l->{COUNT} = $1;
118 0           next;
119             }
120 0 0         if (/^ server platform[\s]+= ([\S]+) (.*)$/) {
121 0           $l->{SERVERPLATFORM} = $1;
122 0           next;
123             }
124 0 0         if (/^ client platform[\s]+= ([\S]+) (.*)$/) {
125 0           $l->{CLIENTPLATFORM} = $1;
126 0           next;
127             }
128 0 0         if (/^ server tier[\s]+= ([\S]+) (.*)$/) {
129 0           $l->{SERVERTIER} = $1;
130 0           next;
131             }
132 0 0         if (/^ client tier[\s]+= ([\S]+) (.*)$/) {
133 0           $l->{CLIENTTIER} = $1;
134 0           next;
135             }
136 0 0         if (/^ license type[\s]+= ([\S]+) (.*)$/) {
137 0           $l->{TYPE} = $1;
138 0           next;
139             }
140 0 0         if (/^ Site ID[\s]+= ([\S]+) (.*)$/) {
141 0           $l->{SITEID} = $1;
142 0           next;
143             }
144 0 0         if (/^ Feature ID[\s]+= ([\S]+) (.*)$/) {
145 0           my $id = $1;
146 0           my $description = $2;
147 0           my $fRef = $l->{FEATURES};
148 0           push @$fRef, $id;
149 0           $featureDescriptions{$id} = $description;
150 0           next;
151             }
152 0 0         if (/^ Expiration[\s]+= (Not e|E)xpired (.*)$/) {
153 0           $l->{EXPIRATION} = str2time($2);
154 0           next;
155             }
156 0 0         if (/^ Time Left[\s]+=/) {
157 0           next;
158             }
159 0 0         if (/^ Firm Expiration[\s]+=/) {
160 0           next;
161             }
162 0           print STDERR "Unknown line in bpminlicense output: \"$_\"\n";
163 0           $legit{$master->name} += 1;
164             }
165 0           $l->install($installHost, $installDate);
166 0           close($pipe);
167              
168              
169             #
170             # If we're inspecting a master, retrieve license keys from active
171             # media managers as well
172 0 0         next if ($mmOnlyP);
173 0           foreach my $ms (NBU::StorageUnit->mediaServers($master)) {
174 0 0         next if (exists($legit{$ms->name}));
175 0           NBU::License->populate($ms, 1);
176             }
177              
178             }
179             }
180              
181             sub install {
182 0     0 0   my $self = shift;
183 0           my ($host, $date) = @_;
184              
185 0           my $installs = $self->{INSTALLS};
186 0           $$installs{$host->name} = $date;
187             }
188              
189             sub hosts {
190 0     0 0   my $self = shift;
191 0           my $installs = $self->{INSTALLS};
192              
193 0           return (keys %$installs);
194             }
195              
196             sub key {
197 0     0 0   my $self = shift;
198              
199 0           return $self->{KEY};
200             }
201              
202             sub list {
203 0     0 0   my $proto = shift;
204              
205 0           return (values %licenses);
206             }
207              
208             sub product {
209 0     0 0   my $self = shift;
210              
211 0           return $self->{PRODUCT};
212             }
213              
214             sub type {
215 0     0 0   my $self = shift;
216              
217 0           return $self->{TYPE};
218             }
219              
220             sub serverTier {
221 0     0 0   my $self = shift;
222              
223 0           return $self->{SERVERTIER};
224             }
225              
226             sub expiration {
227 0     0 0   my $self = shift;
228              
229 0 0         return defined($self->{EXPIRATION}) ? $self->{EXPIRATION} : undef;
230             }
231              
232             sub features {
233 0     0 0   my $self = shift;
234              
235 0           my $fRef = $self->{FEATURES};
236 0           return (@$fRef);
237             }
238              
239             sub demonstration {
240 0     0 0   my $self = shift;
241              
242             # as gleaned from get_license_key script
243 0   0       return ($self->{TYPE} == 0) || ($self->{TYPE} == 5);
244             }
245              
246              
247             my %class2feature = (
248             0 => 20, # Standard
249             # 3 => "Apollo_WBAK",
250             4 => 36, # Oracle
251             # 6 => "Informix",
252             # 7 => "Sybase",
253             # 10 => "NetWare",
254             # 11 => "BackTrack",
255             # 12 => "Auspex_Fastback",
256             13 => 20, # Windows_NT
257             14 => 20, # OS2
258             # 15 => "SQL_Server",
259             # 16 => "Exchange",
260             17 => 40, # SAP
261             # 18 => "DB2",
262             # 19 => "NDMP",
263             # 20 => "FlashBackup",
264             # 21 => "SplitMirror",
265             # 22 => "AFS",
266             );
267              
268             my $blanketFeatureCode = 21;
269             sub licenseForClass {
270 0     0 0   my $proto = shift;
271 0           my $classType = shift;
272 0           my $host = shift;
273              
274 0 0         if (defined(my $featureCode = $class2feature{$classType})) {
275             }
276             }
277              
278             #
279             # Given a feature code, return all license (on the optional host) that
280             # provide the requested feature
281             sub licensesForFeature {
282 0     0 0   my $proto = shift;
283 0           my $featureCode = shift;
284 0           my $host = shift;
285              
286 0           my %list;
287              
288 0           $proto->populate($host);
289 0           for my $l (values %licenses) {
290 0 0 0       next if (defined($host) && ($l->host != $host));
291              
292 0           for my $f ($l->features) {
293 0 0         $list{$l->key} = $l if ($f == $featureCode);
294             }
295             }
296 0           return (values %list);
297             }
298              
299             sub productDescription {
300 0     0 0   my $proto = shift;
301 0           my $productCode = shift;
302              
303 0           return $productDescriptions{$productCode};
304             }
305              
306             sub featureDescription {
307 0     0 0   my $proto = shift;
308 0           my $featureCode = shift;
309              
310 0           return $featureDescriptions{$featureCode};
311             }
312              
313             1;
314              
315             __END__