1 #!perl |
|
2 # Copyright (c) 2000-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
3 # All rights reserved. |
|
4 # This component and the accompanying materials are made available |
|
5 # under the terms of "Eclipse Public License v1.0" |
|
6 # which accompanies this distribution, and is available |
|
7 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
8 # |
|
9 # Initial Contributors: |
|
10 # Nokia Corporation - initial contribution. |
|
11 # |
|
12 # Contributors: |
|
13 # |
|
14 # Description: |
|
15 # |
|
16 |
|
17 use strict; |
|
18 |
|
19 use Getopt::Long; |
|
20 use Cwd; |
|
21 use XML::Simple; |
|
22 use FindBin; |
|
23 use lib "$FindBin::Bin"; |
|
24 |
|
25 my $Now = &Today; |
|
26 my $IncludesRestrictedSource = 0; |
|
27 my $ZippedCatA = 0; |
|
28 my $ZippedCatX = 0; |
|
29 |
|
30 my $WorkPath = uc cwd; |
|
31 $WorkPath =~s-/-\\-go; # replace forward slash with backslash |
|
32 $WorkPath =~s/^(.:)(\S+)$/$2/o; # remove drive letter |
|
33 my $WorkDrv = $1; |
|
34 $WorkPath =~s-^(.*[^\\])$-$1\\-o; # ensure it ends with a backslash |
|
35 |
|
36 my %HTMLFileErrors = (); |
|
37 my %ASCIIFileErrors = (); |
|
38 my %Components = (); |
|
39 my %ComponentsUsed = (); |
|
40 my @UnrepresentedComponents = (); |
|
41 |
|
42 my %Cmdopts = (); |
|
43 unless (GetOptions( \%Cmdopts, "cats|c=s", "dir|d=s", "export|e", "full|f:i", |
|
44 "genpkg|g=s", "help|h", "licensee|l=s", "manifest|m=s", "nosub|n", "overrideexpiry|o", |
|
45 "project|p=s", "report|r=s", "showfiles|s", "xclude|x=s", "zip|z=s", |
|
46 "outdir=s")) |
|
47 { |
|
48 print "For help, use -h option\n"; |
|
49 exit 1; |
|
50 } |
|
51 |
|
52 if (@ARGV && ($ARGV[0]=~/help/io || $ARGV[0]=~/\?/io)) |
|
53 { |
|
54 &Usage(); |
|
55 } |
|
56 |
|
57 # Open Schedule12 File for Component name checking |
|
58 if ($Cmdopts{'report'}) |
|
59 { |
|
60 my $Build = $Cmdopts{'report'}; |
|
61 my $Version = $1 if ( $Build =~ /Symbian_OS_v(.*)/i ); |
|
62 |
|
63 # Define the source root directory (assumes it's 3 levels up) |
|
64 my $sourcedir = Cwd::abs_path("$FindBin::Bin\\..\\..\\.."); |
|
65 my $Schedule12File = "$sourcedir\\os\\deviceplatformrelease\\symbianosbld\\cedarutils\\Symbian_OS_v"."$Version"."_Schedule12.xml"; |
|
66 my $xml = new XML::Simple; |
|
67 my $Schedule12 = $xml->XMLin($Schedule12File); |
|
68 |
|
69 my $CommonReplaceable = %$Schedule12->{'CR'}; |
|
70 for (keys %$CommonReplaceable) |
|
71 { |
|
72 $Components{$_} = "Common Replaceable"; |
|
73 $ComponentsUsed{$_} = 0; |
|
74 } |
|
75 |
|
76 my $CommonSymbian = %$Schedule12->{'CS'}; |
|
77 for (keys %$CommonSymbian) |
|
78 { |
|
79 $Components{$_} = "Common Symbian"; |
|
80 $ComponentsUsed{$_} = 0; |
|
81 } |
|
82 |
|
83 my $OptionalReplaceable = %$Schedule12->{'OR'}; |
|
84 for (keys %$OptionalReplaceable) |
|
85 { |
|
86 $Components{$_} = "Optional Replaceable"; |
|
87 $ComponentsUsed{$_} = 0; |
|
88 } |
|
89 |
|
90 my $OptionalSymbian = %$Schedule12->{'OS'}; |
|
91 for (keys %$OptionalSymbian) |
|
92 { |
|
93 $Components{$_} = "Optional Symbian"; |
|
94 $ComponentsUsed{$_} = 0; |
|
95 } |
|
96 |
|
97 my $ReferenceTest = %$Schedule12->{'REF'}; |
|
98 for (keys %$ReferenceTest) |
|
99 { |
|
100 $Components{$_} = "Reference/Test"; |
|
101 $ComponentsUsed{$_} = 0; |
|
102 } |
|
103 |
|
104 my $ReferenceTest = %$Schedule12->{'TEST'}; |
|
105 for (keys %$ReferenceTest) |
|
106 { |
|
107 $Components{$_} = "Reference/Test"; |
|
108 $ComponentsUsed{$_} = 0; |
|
109 } |
|
110 |
|
111 my $ReferenceTest = %$Schedule12->{'RT'}; # v9.1 style combined Ref/Test |
|
112 for (keys %$ReferenceTest) |
|
113 { |
|
114 $Components{$_} = "Reference/Test"; |
|
115 $ComponentsUsed{$_} = 0; |
|
116 } |
|
117 } |
|
118 |
|
119 # Handle -h flag |
|
120 # -------------- |
|
121 if ($Cmdopts{'help'}) |
|
122 { |
|
123 &Usage(); |
|
124 } |
|
125 |
|
126 # -------------- |
|
127 # Handle -c flag |
|
128 # -------------- |
|
129 my $Categories = 'EFGOT'; |
|
130 if ($Cmdopts{'cats'}) |
|
131 { |
|
132 if ($Cmdopts{'cats'} =~ /[^A-GIOTX]/i) |
|
133 { |
|
134 &NotifyError("Unrecognised category list \"$Cmdopts{'cats'}\" ignored"); |
|
135 } |
|
136 else |
|
137 { |
|
138 $Categories = uc($Cmdopts{'cats'}); |
|
139 } |
|
140 } |
|
141 |
|
142 # -------------- |
|
143 # Handle -d flag |
|
144 # -------------- |
|
145 my @TopDirs; |
|
146 if (!$Cmdopts{'dir'}) |
|
147 { |
|
148 $TopDirs[0] = $WorkPath; |
|
149 } |
|
150 else |
|
151 { |
|
152 if (!(-e $Cmdopts{'dir'})) |
|
153 { |
|
154 die "$Cmdopts{'dir'} does not exist\n"; |
|
155 } |
|
156 if (-d $Cmdopts{'dir'}) |
|
157 { |
|
158 $TopDirs[0] = $Cmdopts{'dir'}; |
|
159 } |
|
160 else |
|
161 { |
|
162 @TopDirs = &ReadDirFile($Cmdopts{'dir'}); |
|
163 } |
|
164 @TopDirs = &MakeAbs($WorkPath, @TopDirs); |
|
165 foreach my $p (@TopDirs) |
|
166 { |
|
167 $p = &ValidateIncPath($p); |
|
168 } |
|
169 } |
|
170 |
|
171 # -------------- |
|
172 # Handle -e flag |
|
173 # -------------- |
|
174 my $ForceExport = $Cmdopts{'export'} ? 1 : 0; |
|
175 |
|
176 # -------------- |
|
177 # Handle -f flag |
|
178 # -------------- |
|
179 my $Full = $Cmdopts{'full'} || 0; |
|
180 |
|
181 |
|
182 # -------------- |
|
183 # Handle -g flag |
|
184 # -------------- |
|
185 my $PkgFile; |
|
186 my $GenPkg = $Cmdopts{'genpkg'} ? 1 : 0; |
|
187 if ($GenPkg) |
|
188 { |
|
189 $PkgFile = $Cmdopts{'genpkg'}; |
|
190 if (index($PkgFile, "\.") < 0) |
|
191 { |
|
192 $PkgFile .= "\.xml"; |
|
193 } |
|
194 if ((-e $PkgFile) and (-f $PkgFile)) |
|
195 { |
|
196 unlink ($PkgFile) or die "Can't overwrite $PkgFile\n"; |
|
197 } |
|
198 open PKGLIST, ">$PkgFile" or die "Can't open $PkgFile\n"; |
|
199 } |
|
200 |
|
201 |
|
202 # -------------- |
|
203 # Handle -l flag |
|
204 # -------------- |
|
205 my $Recipient = 'generic'; |
|
206 if ($Cmdopts{'licensee'}) |
|
207 { |
|
208 $Recipient = lc($Cmdopts{'licensee'}); |
|
209 } |
|
210 |
|
211 # -------------- |
|
212 # Handle -m flag |
|
213 # -------------- |
|
214 my $Manifest = $Cmdopts{'manifest'} ? 1 : 0; |
|
215 if ($Manifest) |
|
216 { |
|
217 my $MfsFile = $Cmdopts{'manifest'}; |
|
218 if (index($MfsFile, "\.") < 0) |
|
219 { |
|
220 $MfsFile .= "\.txt"; |
|
221 } |
|
222 if ((-e $MfsFile) and (-f $MfsFile)) |
|
223 { |
|
224 unlink ($MfsFile) or die "Can't overwrite $MfsFile\n"; |
|
225 } |
|
226 open MFSLIST, ">$MfsFile" or die "Can't open $MfsFile\n"; |
|
227 } |
|
228 |
|
229 |
|
230 # -------------- |
|
231 # Handle -n flag |
|
232 # -------------- |
|
233 my $SubDirs = $Cmdopts{'nosub'} ? 0 : 1; |
|
234 |
|
235 # -------------- |
|
236 # Handle -o flag |
|
237 # -------------- |
|
238 my $OverrideExpiry = $Cmdopts{'overrideexpiry'} ? 1 : 0; |
|
239 |
|
240 # -------------- |
|
241 # Handle -outdir flag |
|
242 # -------------- |
|
243 my $outdir = $Cmdopts{'outdir'}; |
|
244 |
|
245 # -------------- |
|
246 # Handle -p flag |
|
247 # -------------- |
|
248 my $Project = 'generic'; |
|
249 if ($Cmdopts{'project'}) |
|
250 { |
|
251 $Project = lc($Cmdopts{'project'}); |
|
252 } |
|
253 |
|
254 # -------------- |
|
255 # Handle -s flag |
|
256 # -------------- |
|
257 my $ShowFiles = $Cmdopts{'showfiles'} ? 1 : 0; |
|
258 |
|
259 # -------------- |
|
260 # Handle -x flag |
|
261 # -------------- |
|
262 my @XDirs; |
|
263 if (!$Cmdopts{'xclude'}) |
|
264 { |
|
265 $XDirs[0] = ""; |
|
266 } |
|
267 else |
|
268 { |
|
269 if (!(-e $Cmdopts{'xclude'})) |
|
270 { |
|
271 die "Exclusion $Cmdopts{'xclude'} does not exist\n"; |
|
272 } |
|
273 if (-d $Cmdopts{'xclude'}) |
|
274 { |
|
275 $XDirs[0] = $Cmdopts{'xclude'}; |
|
276 } |
|
277 else |
|
278 { |
|
279 @XDirs = &ReadDirFile($Cmdopts{'xclude'}); |
|
280 } |
|
281 @XDirs = &MakeAbs($WorkPath, @XDirs); |
|
282 foreach my $p (@XDirs) |
|
283 { |
|
284 $p = &ValidateExcPath($p); |
|
285 } |
|
286 } |
|
287 |
|
288 # -------------- |
|
289 # Handle -z flag |
|
290 # -------------- |
|
291 my $ZipFile; |
|
292 my $ZipTmpFile; |
|
293 my $ZipLogFile; |
|
294 my $Zip = $Cmdopts{'zip'} ? 1 : 0; |
|
295 if ($Zip) |
|
296 { |
|
297 if ( &FindZip == 0 ) |
|
298 { |
|
299 die "Cannot find zip.exe in path. $?\n"; |
|
300 } |
|
301 |
|
302 $ZipFile = $Cmdopts{'zip'}; |
|
303 if (index($ZipFile, "\.") < 0) |
|
304 { |
|
305 $ZipFile .= "\.zip"; |
|
306 } |
|
307 $ZipLogFile = $ZipFile . "log"; |
|
308 $ZipTmpFile = $ZipFile . "tmp"; |
|
309 if ((-e $ZipFile) and (-f $ZipFile)) |
|
310 { |
|
311 unlink ($ZipFile) or die "Can't overwrite $ZipFile\n"; |
|
312 } |
|
313 if ((-e $ZipTmpFile) and (-f $ZipTmpFile)) |
|
314 { |
|
315 unlink ($ZipTmpFile) or die "Can't overwrite $ZipTmpFile\n"; |
|
316 } |
|
317 open ZIPLIST, ">$ZipTmpFile" or die "Can't open $ZipTmpFile\n"; |
|
318 } |
|
319 |
|
320 |
|
321 |
|
322 # -------------- |
|
323 # print Pkg header |
|
324 # -------------- |
|
325 |
|
326 if ($GenPkg) |
|
327 { |
|
328 &PkgPrint ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"); |
|
329 &PkgPrint ("\n"); |
|
330 |
|
331 &PkgPrint ("<packagedef version=\"1.0\">\n"); |
|
332 &PkgPrint (" <package name=\"$PkgFile\" major-version=\"0\" minor-version=\"0\">\n"); |
|
333 &PkgPrint (" <supplier>Symbian Ltd</supplier>\n"); |
|
334 &PkgPrint (" <sdk-version>7.0</sdk-version>\n"); |
|
335 &PkgPrint (" </package>\n"); |
|
336 &PkgPrint ("\n"); |
|
337 &PkgPrint (" <manifest>\n"); |
|
338 } |
|
339 |
|
340 |
|
341 #------ Do the report header ------ |
|
342 my $temp ="IPR Report, ".&DateValToStr($Now); |
|
343 &DataPrint("$temp\n"); |
|
344 $temp = '-' x length($temp); |
|
345 &DataPrint("$temp\n"); |
|
346 |
|
347 &DataPrint ("Report type: "); |
|
348 if ($Full < 0) |
|
349 { |
|
350 &DataPrint ("No IPR data\n") ; |
|
351 } |
|
352 else |
|
353 { |
|
354 &DataPrint ($Full ? "Full IPR data\n" : "Reduced IPR data\n"); |
|
355 } |
|
356 &DataPrint ("Recipient: ", ucfirst($Recipient), "\n"); |
|
357 &DataPrint ("Include DTI restricted files: ", $ForceExport ? 'Yes' : 'No', "\n"); |
|
358 &DataPrint ("Include time-expired files: ", $OverrideExpiry ? 'Yes' : 'No', "\n"); |
|
359 &DataPrint ("List selected files: ", $ShowFiles ? 'Yes' : 'No', "\n"); |
|
360 &DataPrint ("\n"); |
|
361 |
|
362 #------ Do header for standard section ------ |
|
363 $temp ="Standard source for ".ucfirst($Recipient); |
|
364 &DataPrint ("$temp\n"); |
|
365 $temp = '-' x length($temp); |
|
366 &DataPrint ("$temp\n"); |
|
367 &DataPrint ("Categories: $Categories\n"); |
|
368 &DataPrint ("Include subdirectories: ", $SubDirs ? 'Yes' : 'No', "\n"); |
|
369 &DataPrint ("Top level directories:\n"); |
|
370 foreach my $name (@TopDirs) |
|
371 { |
|
372 &DataPrint (" $name\n"); |
|
373 } |
|
374 &DataPrint ("\n"); |
|
375 |
|
376 &ProcessDir(@TopDirs, $SubDirs, 1, $Manifest); |
|
377 |
|
378 #------ Do optional header for extra section ------ |
|
379 if (($Project ne 'generic') and (-e "$Project\.extra")) |
|
380 { |
|
381 my @ExtraDirs = ReadDirFile("$Project\.extra"); |
|
382 @ExtraDirs = &MakeAbs($WorkPath, @ExtraDirs); |
|
383 foreach my $p (@ExtraDirs) |
|
384 { |
|
385 $p = &ValidateIncPath($p); |
|
386 } |
|
387 &DataPrint ("\n"); |
|
388 $temp ="Extra source for ".ucfirst($Project); |
|
389 &DataPrint ("$temp\n"); |
|
390 $temp = '-' x length($temp); |
|
391 &DataPrint ("$temp\n"); |
|
392 $Categories = 'ABCDEFGIOTX'; |
|
393 &DataPrint ("Categories: $Categories\n"); |
|
394 &DataPrint ("Include subdirectories: No\n"); |
|
395 &DataPrint ("Additional directories:\n"); |
|
396 foreach my $name (@ExtraDirs) |
|
397 { |
|
398 if ($name) |
|
399 { |
|
400 &DataPrint (" $name\n"); |
|
401 } |
|
402 } |
|
403 &DataPrint ("\n"); |
|
404 |
|
405 &ProcessDir(@ExtraDirs, 0, 0, 0); # Note, no extra directories in a product manifest |
|
406 } |
|
407 |
|
408 if ($Zip) |
|
409 { |
|
410 if ( &FindZip == 0 ) |
|
411 { |
|
412 die "Cannot find zip.exe in path. $?\n"; |
|
413 } |
|
414 |
|
415 close ZIPLIST; |
|
416 `zip -@ $ZipFile <$ZipTmpFile >$ZipLogFile`; |
|
417 unlink ($ZipTmpFile); |
|
418 } |
|
419 |
|
420 if ($Manifest) |
|
421 { |
|
422 close MFSLIST; |
|
423 } |
|
424 |
|
425 # -------------------------- |
|
426 # print Pkg footer and close |
|
427 # -------------------------- |
|
428 |
|
429 if ($GenPkg) |
|
430 { |
|
431 &PkgPrint (" </manifest>\n"); |
|
432 &PkgPrint ("</packagedef>\n"); |
|
433 close PKGLIST; |
|
434 } |
|
435 |
|
436 #------ Do optional warning for restricted export source ------ |
|
437 &ExportWarning() if ($IncludesRestrictedSource); |
|
438 &NotifyWarning("zip file contains Category A source\n") if ($ZippedCatA); |
|
439 &NotifyWarning("zip file contains uncategorised source\n") if ($ZippedCatX); |
|
440 |
|
441 if ($Cmdopts{'report'}) |
|
442 { |
|
443 #------ Produce Distribution Policy File Error Report -------- |
|
444 my ( $s, $min, $hour, $mday, $mon, $year, $w, $y, $i)= localtime(time); |
|
445 $year+= 1900; |
|
446 $mon++; |
|
447 |
|
448 my $builddir = $outdir; |
|
449 if (!defined $builddir) |
|
450 { |
|
451 # Assume default setup for Symbian build machines... |
|
452 $builddir = Cwd::abs_path("$FindBin::Bin\\..\\..\\..\\.."); |
|
453 $builddir.= "\\logs\\cedar"; |
|
454 } |
|
455 open HTMLOUTFILE, ">> $builddir\\$Cmdopts{'report'}_Distribution_Policy_Report.html"; |
|
456 open ASCIIOUTFILE, ">> $builddir\\$Cmdopts{'report'}_Distribution_Policy_Report.txt"; |
|
457 |
|
458 foreach my $key (sort keys %ComponentsUsed) |
|
459 { |
|
460 push @UnrepresentedComponents, $key if ($ComponentsUsed{$key} == 0); |
|
461 } |
|
462 |
|
463 my $UnrepCKLComponents = @UnrepresentedComponents; |
|
464 my $NonCompliantFiles = scalar(keys %ASCIIFileErrors); |
|
465 |
|
466 print HTMLOUTFILE <<HEADING_EOF; |
|
467 <html><head><title>Distribution Policy File Report for $Cmdopts{'report'}</title></head> |
|
468 <body> |
|
469 <h1><center>Distribution Policy File Report<br>for<br>$Cmdopts{'report'}</center></h1> |
|
470 <h2><center>Created - $mday/$mon/$year</center></h2> |
|
471 <hr width=60% size=1 noshade> <p><p><p><p> |
|
472 |
|
473 <TABLE BORDER Align=center> |
|
474 <TH COLSPAN=2><font color=red>Report Summary</font></TH> |
|
475 <TR><TD>Total number of Non-compliant Files</TD><TD><b>$NonCompliantFiles</b></TD></TR> |
|
476 <TR><TD>Total number of Unrepresented CKL Components</TD><TD><b>$UnrepCKLComponents</b></TD></TR> |
|
477 </TABLE><p><p><p><p> |
|
478 |
|
479 <TABLE BORDER ALIGN=center> |
|
480 <TH COLSPAN=2>Non-Compliant Files</font></TH> |
|
481 <TR><TH>File Location</TH><TH>Errors</TH></TR> |
|
482 HEADING_EOF |
|
483 |
|
484 print ASCIIOUTFILE <<HEADING_EOF; |
|
485 Distribution Policy File Report for $Cmdopts{'report'} |
|
486 Created - $mday/$mon/$year |
|
487 ================================ |
|
488 |
|
489 HEADING_EOF |
|
490 |
|
491 foreach my $key (sort keys %ASCIIFileErrors) |
|
492 { |
|
493 my $path = lc $key; |
|
494 $path =~ s/^.*?\\master\\.*?\\src\\/\\src\\/i; |
|
495 print HTMLOUTFILE "<TR><TD><font face=verdana size=4>$path</TD><TD>@{$HTMLFileErrors{$key}}</TD></TR>"; |
|
496 print ASCIIOUTFILE "@{$ASCIIFileErrors{$key}}"; |
|
497 } |
|
498 print HTMLOUTFILE "</TABLE><p><p><p><p>"; |
|
499 |
|
500 if (@UnrepresentedComponents != 0) |
|
501 { |
|
502 print HTMLOUTFILE "<TABLE BORDER ALIGN=center>"; |
|
503 print HTMLOUTFILE "<TR><TH>Unrepresented Components</TH></TR>"; |
|
504 foreach my $component (@UnrepresentedComponents) |
|
505 { |
|
506 print HTMLOUTFILE "<TR><TD>Component '$component' as recorded in |
|
507 Schedule 12 of the CKL has no representation in any of the source directories that are used to build this product</TD></TR>"; |
|
508 |
|
509 print ASCIIOUTFILE "Unrepresented Component, Component '$component' as recorded in Schedule 12 of the CKL has no representation in any of the source directories that are used to build this product.\n"; |
|
510 } |
|
511 print HTMLOUTFILE "</TABLE>"; |
|
512 } |
|
513 |
|
514 close HTMLOUTFILE; |
|
515 close ASCIIOUTFILE; |
|
516 } |
|
517 |
|
518 |
|
519 |
|
520 sub ProcessDir |
|
521 { |
|
522 my $ForManifest = pop @_; |
|
523 my $ObeyExcludes = pop @_; |
|
524 my $Subdirs = pop @_; |
|
525 my $Category = 'X'; |
|
526 my $ExpiryDate = 0; |
|
527 my $NoExport = 0; |
|
528 my $Skip = 0; |
|
529 my $Name; |
|
530 my $FoundFile; |
|
531 my $FoundPol; |
|
532 my $PathName; |
|
533 my $Text; |
|
534 my @AllFiles; |
|
535 my @Recipients; |
|
536 my %LicExpDates; |
|
537 |
|
538 foreach $PathName (@_) |
|
539 { |
|
540 if (!$PathName) { next; } |
|
541 if ($ForManifest) |
|
542 { |
|
543 my $path = $PathName; |
|
544 # $path =~ s/^\\//; # remove any leading backslash |
|
545 $path =~ s/\\$//; # remove any trailing backslash |
|
546 &MfsPrint ("COMPONENT\t$path\n"); |
|
547 } |
|
548 if ($ObeyExcludes) |
|
549 { |
|
550 foreach my $exclude (@XDirs) |
|
551 { |
|
552 my $ex = $exclude; |
|
553 my $pn = $PathName; |
|
554 if (uc $ex eq uc $pn) |
|
555 { |
|
556 $Skip = 1; |
|
557 last; |
|
558 } |
|
559 } |
|
560 if ($Skip) |
|
561 { |
|
562 next; |
|
563 } |
|
564 } |
|
565 $FoundFile = 0; |
|
566 $FoundPol = 0; |
|
567 opendir(HERE, $PathName); |
|
568 @AllFiles = readdir(HERE); |
|
569 close(HERE); |
|
570 foreach my $Name (@AllFiles) |
|
571 { |
|
572 if (-d "$PathName$Name") { next; } |
|
573 if (lc($Name) eq 'distribution.policy') |
|
574 { |
|
575 $FoundPol = 1; |
|
576 ($Category, $ExpiryDate, $NoExport, $Text, %LicExpDates) = &IprStatus("$PathName$Name"); |
|
577 |
|
578 if ($Cmdopts{'report'}) |
|
579 { |
|
580 my ($HTMLErrors, $ASCIIErrors) = &CheckFileContents("$PathName$Name"); |
|
581 @{$HTMLFileErrors{"$PathName"}} = @{$HTMLErrors} if (@{$HTMLErrors} > 0); |
|
582 @{$ASCIIFileErrors{"$PathName"}} = @{$ASCIIErrors} if (@{$ASCIIErrors} > 0); |
|
583 } |
|
584 } |
|
585 else |
|
586 { |
|
587 $FoundFile = 1; |
|
588 } |
|
589 } |
|
590 if ($FoundFile and (!$FoundPol)) { &NotifyError("no policy file in $PathName"); } |
|
591 if ((!$FoundFile) and $FoundPol) |
|
592 { |
|
593 &NotifyNote("unnecessary policy file in $PathName"); |
|
594 $FoundFile = 1; # Force a report of a directory containing only a policy file |
|
595 } |
|
596 |
|
597 &ConditionalRep($FoundFile, $PathName, $Category, $ExpiryDate, $NoExport, $Text, %LicExpDates); |
|
598 |
|
599 if ($Subdirs) |
|
600 { |
|
601 foreach my $Name (@AllFiles) |
|
602 { |
|
603 if (-d "$PathName$Name") |
|
604 { |
|
605 if ($Name eq '.') { next; } |
|
606 if ($Name eq '..') { next; } |
|
607 &ProcessDir("$PathName$Name\\", 1, $ObeyExcludes, 0); |
|
608 } |
|
609 } |
|
610 } |
|
611 } |
|
612 } |
|
613 |
|
614 sub CheckFileContents |
|
615 { |
|
616 my $Location = shift; |
|
617 $Location = lc $Location; |
|
618 |
|
619 my $path = $Location; |
|
620 $path =~ s/\\distribution.policy//; # Remove file name from end of path |
|
621 |
|
622 my @HTMLFileErrors = (); |
|
623 my @ASCIIFileErrors = (); |
|
624 my $Category; |
|
625 my $OSDclass; |
|
626 my $ComponentName; |
|
627 |
|
628 my $CategoryLineFound = 0; |
|
629 my $OSClassLineFound = 0; |
|
630 |
|
631 open(DPFile, $Location); |
|
632 |
|
633 while (<DPFile>) |
|
634 { |
|
635 # Check Comment Lines |
|
636 if ($_ =~ /^\s*#(.*)$/) |
|
637 { |
|
638 if ($1 =~ /#/) |
|
639 { |
|
640 push @HTMLFileErrors, "<font face=verdana size=4><b>Line = </b>$_</font><br><font face=arial size=4 color=red>Comment line contains # as part of the comment.</font><p>\n"; |
|
641 push @ASCIIFileErrors, "$path, Comment line contains # as part of the comment.\n"; |
|
642 } |
|
643 next; |
|
644 } |
|
645 |
|
646 # Check Source Category Line |
|
647 if ($_ =~ /^\s*Category.*$/i) |
|
648 { |
|
649 $CategoryLineFound++; |
|
650 if (!($_ =~ /^\s*Category\s+\w{1}\s*$/i)) |
|
651 { |
|
652 push @HTMLFileErrors, "<font face=verdana size=4><b>Line = </b>$_</font><br><font face=arial size=4 color=red>Line Syntax is incorrrect.</font><br>\n"; |
|
653 push @ASCIIFileErrors, "$path, Category line syntax is incorrect.\n"; |
|
654 |
|
655 if ($_ =~ /^\s*Category(.*?)\w{1}\s*(.*)$/i) |
|
656 { |
|
657 if (!($1 =~ /^\s+$/)) |
|
658 { |
|
659 push @HTMLFileErrors, "<font face=arial size=4 color=red>The word Category and the Source-Category should be seperated by a whitespace not '$1'.</font><br>\n"; |
|
660 push @ASCIIFileErrors, "$path, The word Category and the Source-Category should be seperated by a whitespace not '$1'.\n"; |
|
661 } |
|
662 if ($2 ne "") |
|
663 { |
|
664 push @HTMLFileErrors, "<font face=arial size=4 color=red>Trailing characters '$2' after the Source-Category are not allowed.</font><br>\n"; |
|
665 push @ASCIIFileErrors, "$path, Trailing characters '$2' after the Source-Category are not allowed.\n"; |
|
666 } |
|
667 |
|
668 push @HTMLFileErrors, "<p>\n"; |
|
669 next; |
|
670 } |
|
671 } |
|
672 if ($_ =~ /^\s*Category\s+(\w{1})\s*$/) |
|
673 { |
|
674 $Category = uc $1; |
|
675 if ($Category !~ /[A-GIOT]/) |
|
676 { |
|
677 push @HTMLFileErrors, "<font face=verdana size=4><b>Line = </b>$_</font><br><font face=arial size=4 color=red>Category $Category is not a defined Source-Category.</font><p>\n"; |
|
678 push @ASCIIFileErrors, "$path, Category $Category is not a defined Source-Category.\n"; |
|
679 } |
|
680 next; |
|
681 } |
|
682 } |
|
683 |
|
684 # Check OS Class Line |
|
685 if ($_ =~ /^\s*OSD.*$/i) |
|
686 { |
|
687 $OSClassLineFound++; |
|
688 if (!($_ =~ /\s*OSD:\s+\w+.?\w+\s+.*\s*$/i)) |
|
689 { |
|
690 push @HTMLFileErrors, "<font face=verdana size=4><b>Line = </b>$_</font><br><font face=arial size=4 color=red>OSD line syntax is incorrect</font><br>\n"; |
|
691 push @ASCIIFileErrors, "$path, OSD line syntax is incorrect.\n"; |
|
692 |
|
693 if (!($_ =~ /OSD:\s+/i)) |
|
694 { |
|
695 push @HTMLFileErrors, "<font face=arial size=4 color=red>OSD line does not begin with 'OSD: '</font><br>\n" ; |
|
696 push @ASCIIFileErrors, "$path, OSD line does not begin with 'OSD: '.\n"; |
|
697 } |
|
698 |
|
699 if ($_ =~ /OSD:\s+(.*)\s+(.*)/i) |
|
700 { |
|
701 my $class = $1; |
|
702 my $compname = lc $2; |
|
703 $compname =~ s/\s+$//; |
|
704 # Workaround for this particular string |
|
705 if (($_ =~ /Optional:/)&&($_ =~ /Test/)&&($_ =~ /RTP/)) |
|
706 { |
|
707 $class = "Optional: Test"; |
|
708 $compname = "rtp"; |
|
709 } |
|
710 if ((!($class =~ /^Common Replaceable$/i))&&(!($class =~ /^Common Symbian$/i))&&(!($class =~ /^Optional Replaceable$/i))&&(!($class =~ /^Optional Symbian$/i)) |
|
711 &&(!($class =~ /^Reference\/Test$/i))&&(!($class =~ /^Reference\\Test$/i))&&(!($class =~ /^Test\/Reference$/i))&&(!($class =~ /^Test\\Reference$/i))) |
|
712 { |
|
713 push @HTMLFileErrors, "<font face=arial size=4 color=red>OSD Class '$class' is not a defined OSD Class.</font><br>\n" ; |
|
714 push @ASCIIFileErrors, "$path, OSD Class '$class' is not a defined OSD Class.\n"; |
|
715 } |
|
716 |
|
717 if (!($compname =~ /[a-z]+/)) |
|
718 { |
|
719 push @HTMLFileErrors, "<font face=arial size=4 color=red>No Component name specified on OSD line.</font><br>\n" ; |
|
720 push @ASCIIFileErrors, "$path, No Component name specified on OSD line.\n"; |
|
721 |
|
722 } |
|
723 |
|
724 foreach my $key (sort keys %ComponentsUsed) |
|
725 { |
|
726 my $lowercasename = lc $key; |
|
727 $lowercasename =~ s/\s+$//; |
|
728 if ($compname eq $lowercasename) |
|
729 { |
|
730 $ComponentsUsed{$key} = 1; |
|
731 last; |
|
732 } |
|
733 } |
|
734 } |
|
735 push @HTMLFileErrors, "<p>\n"; |
|
736 |
|
737 next; |
|
738 } |
|
739 if ($_ =~ /\s*OSD:\s+(\w+.?\w+)\s+(.*)\s*$/) |
|
740 { |
|
741 my $OSDclass = $1; |
|
742 my $ComponentName = $2; |
|
743 my $OSDLineError = 0; |
|
744 |
|
745 if ($OSDclass eq "") |
|
746 { |
|
747 push @HTMLFileErrors, "<font face=verdana size=4><b>Line = </b>$_</font><br><font face=arial size=4 color=red>OSD Class is not specified.</font><br>\n"; |
|
748 push @ASCIIFileErrors, "$path, OSD Class is not specified.\n"; |
|
749 $OSDLineError = 1; |
|
750 } |
|
751 if ($ComponentName eq "") |
|
752 { |
|
753 if ($OSDLineError == 0) |
|
754 { |
|
755 push @HTMLFileErrors, "<font face=verdana size=4><b>Line = </b>$_</font><br><font face=arial size=4 color=red>No Component Name specified on the OSD line.</font><br>\n"; |
|
756 push @ASCIIFileErrors, "$path, No Component Name specified on the OSD line.\n"; |
|
757 $OSDLineError = 1; |
|
758 } |
|
759 else |
|
760 { |
|
761 push @HTMLFileErrors, "<font face=arial size=4 color=red>No Component Name specified on the OSD line.</font><br>\n"; |
|
762 push @ASCIIFileErrors, "$path, No Component Name specified on the OSD line.\n"; |
|
763 } |
|
764 } |
|
765 if (($OSDclass ne "")&&(!($OSDclass =~ /^Common Replaceable$/i))&&(!($OSDclass =~ /^Common Symbian$/i))&&(!($OSDclass =~ /^Optional Replaceable$/i))&&(!($OSDclass =~ /^Optional Symbian$/i)) |
|
766 &&(!($OSDclass =~ /^Reference\/Test$/i))&&(!($OSDclass =~ /^Reference\\Test$/i))&&(!($OSDclass =~ /^Test\/Reference$/i))&&(!($OSDclass =~ /^Test\\Reference$/i))) |
|
767 { |
|
768 if ($OSDLineError == 0) |
|
769 { |
|
770 push @HTMLFileErrors, "<font face=verdana size=4><b>Line = </b>$_</font><br><font face=arial size=4 color=red>OSD Class '$OSDclass' is not a defined OSD Class.</font><br>\n"; |
|
771 push @ASCIIFileErrors, "$path, OSD Class '$OSDclass' is not a defined OSD Class.\n"; |
|
772 $OSDLineError = 1; |
|
773 } |
|
774 else |
|
775 { |
|
776 push @HTMLFileErrors, "<font face=arial size=4 color=red>OSD Class '$OSDclass' is not a defined OSD Class.</font><br>\n"; |
|
777 push @ASCIIFileErrors, "$path, OSD Class '$OSDclass' is not a defined OSD Class.\n"; |
|
778 } |
|
779 } |
|
780 if((defined $Category)&&($Category eq 'D')&&(!($OSDclass =~ /^Common Symbian$/i))) |
|
781 { |
|
782 if ($OSDLineError == 0) |
|
783 { |
|
784 push @HTMLFileErrors, "<font face=verdana size=4><b>Line = </b>$_</font><br><font face=arial size=4 color=red>All Category 'D' code must be assigned to a CKL component of OSD Class 'Common Symbian'.</font><br>\n"; |
|
785 push @ASCIIFileErrors, "$path, All Category 'D' code must be assigned to a CKL component of OSD Class 'Common Symbian'.\n"; |
|
786 $OSDLineError = 1; |
|
787 } |
|
788 else |
|
789 { |
|
790 push @HTMLFileErrors, "<font face=arial size=4 color=red>All Category 'D' code must be assigned to a CKL component of OSD Class 'Common Symbian'.</font><br>\n"; |
|
791 push @ASCIIFileErrors, "$path, All Category 'D' code must be assigned to a CKL component of OSD Class 'Common Symbian'.\n"; |
|
792 } |
|
793 } |
|
794 if((defined $Category)&&($OSDclass =~ /^Common Symbian$/i)) |
|
795 { |
|
796 if (($Category eq 'E')) |
|
797 { |
|
798 if ($OSDLineError == 0) |
|
799 { |
|
800 push @HTMLFileErrors, "<font face=verdana size=4><b>Line = </b>$_</font><br><font face=arial size=4 color=red>A 'Common Symbian' OSD Class component must not contain Source Category '$Category' code.</font><br>\n"; |
|
801 push @ASCIIFileErrors, "$path, A 'Common Symbian' OSD Class component must not contain Source Category '$Category' code.\n"; |
|
802 $OSDLineError = 1; |
|
803 } |
|
804 else |
|
805 { |
|
806 push @HTMLFileErrors, "<font face=arial size=4 color=red>A 'Common Symbian' OSD Class component must not contain Source Category '$Category' code.</font><br>\n"; |
|
807 push @ASCIIFileErrors, "$path, A 'Common Symbian' OSD Class component must not contain Source Category '$Category' code.\n"; |
|
808 } |
|
809 } |
|
810 } |
|
811 |
|
812 push @HTMLFileErrors, "<p>\n" if ($OSDLineError != 0); |
|
813 |
|
814 #Check $ComponentName and OSD-Class against data in Schedule12 of the CKL |
|
815 if ($ComponentName ne "") |
|
816 { |
|
817 my $componentmatch = 0; |
|
818 my $OSDmatch = 0; |
|
819 my $Schedule12OSDClass; |
|
820 my $component = lc $ComponentName; |
|
821 $component =~ s/\s+$//; |
|
822 my $osdclass = lc $OSDclass; |
|
823 $osdclass =~ s/\s+$//; |
|
824 |
|
825 foreach my $Schedule12Component (sort keys %Components) |
|
826 { |
|
827 my $schedule12component = lc $Schedule12Component; |
|
828 $schedule12component =~ s/\s+$//; |
|
829 if ($component eq $schedule12component) |
|
830 { |
|
831 $componentmatch = 1; |
|
832 $ComponentsUsed{$Schedule12Component} = 1; |
|
833 } |
|
834 if ($componentmatch == 1) |
|
835 { |
|
836 $Schedule12OSDClass = $Components{$Schedule12Component}; |
|
837 my $schedule12osdclass = lc $Schedule12OSDClass; |
|
838 $schedule12osdclass =~ s/\s+$//; |
|
839 $OSDmatch = 1 if ($schedule12osdclass eq $osdclass); |
|
840 |
|
841 if (($osdclass eq "reference\\test")||($osdclass eq "test\\reference")||($osdclass eq "test\/reference")) |
|
842 { |
|
843 $OSDmatch = 1 if ($schedule12osdclass eq "reference\/test"); |
|
844 } |
|
845 last; |
|
846 } |
|
847 } |
|
848 |
|
849 if ($componentmatch == 0) |
|
850 { |
|
851 push @HTMLFileErrors, "<font face=arial size=4 color=red>Component '$ComponentName' is not listed in Schedule 12 of the CKL.</font><p>\n"; |
|
852 push @ASCIIFileErrors, "$path, Component '$ComponentName' is not listed in Schedule 12 of the CKL.\n"; |
|
853 } |
|
854 if (($componentmatch == 1)&&($OSDmatch == 0)) |
|
855 { |
|
856 if (($Category == 'T') && (($osdclass eq "reference\\test")||($osdclass eq "test\\reference")||($osdclass eq "test\/reference")||($osdclass eq "reference\/test"))) |
|
857 { |
|
858 |
|
859 } |
|
860 else |
|
861 { |
|
862 push @HTMLFileErrors, "<font face=arial size=4 color=red>According to Schedule 12 of the CKL, component '$ComponentName' should be assigned to OSD Class '$Schedule12OSDClass' not '$OSDclass'.</font><p>\n"; |
|
863 push @ASCIIFileErrors, "$path, According to Schedule 12 of the CKL component '$ComponentName' should be assigned to OSD Class '$Schedule12OSDClass' not '$OSDclass'.\n"; |
|
864 } |
|
865 } |
|
866 } |
|
867 } |
|
868 } |
|
869 } |
|
870 push @HTMLFileErrors, "<font face=arial size=4 color=red>Category Line is missing.</font><p>" if ($CategoryLineFound == 0); |
|
871 push @ASCIIFileErrors, "$path, Category Line is missing.\n" if ($CategoryLineFound == 0); |
|
872 push @HTMLFileErrors, "<font face=arial size=4 color=red>OSD Line is missing.</font><p>" if ($OSClassLineFound == 0); |
|
873 push @ASCIIFileErrors, "$path, OSD Line is missing.\n" if ($OSClassLineFound == 0); |
|
874 |
|
875 push @HTMLFileErrors, "<font face=arial size=4 color=red>File contains $CategoryLineFound Category Lines.</font><p>" if ($CategoryLineFound > 1); |
|
876 push @ASCIIFileErrors, "$path, File contains $CategoryLineFound Category Lines.\n" if ($CategoryLineFound > 1); |
|
877 push @HTMLFileErrors, "<font face=arial size=4 color=red>File contains $OSClassLineFound OSD Lines.</font><p>" if ($OSClassLineFound > 1); |
|
878 push @ASCIIFileErrors, "$path, File contains $OSClassLineFound OSD Lines.\n" if ($OSClassLineFound > 1); |
|
879 |
|
880 return \@HTMLFileErrors, \@ASCIIFileErrors; |
|
881 } |
|
882 |
|
883 sub IprStatus |
|
884 { |
|
885 my $Location = shift; |
|
886 my $ThisCategory = 'X'; |
|
887 my $CatSet = 0; |
|
888 my $Expiry = 0; # 0 represents no expiry date set |
|
889 my $Restricted = 0; |
|
890 my $ThisLine = 0; |
|
891 my $Description; |
|
892 my %ShipData; |
|
893 open(IPR, $Location); |
|
894 while (<IPR>) |
|
895 { |
|
896 $_ = lc $_; |
|
897 $ThisLine += 1; |
|
898 |
|
899 s/\s*#.*$//; # ignore comments and blank lines |
|
900 if ($_ =~ /^$/) { next; } |
|
901 |
|
902 if ($_ =~ /category\s+(\w)/) # CATEGORY statements |
|
903 { |
|
904 my $aCat=uc($1); |
|
905 if (($aCat =~ /[^A-GIOT]/)) |
|
906 { |
|
907 &ErrorLoc("illegal Category statement", $ThisLine, $Location); |
|
908 $ThisCategory = 'X'; |
|
909 $CatSet = 1; |
|
910 next; |
|
911 } |
|
912 if ($CatSet) |
|
913 { |
|
914 &ErrorLoc("repeated Category statement", $ThisLine, $Location); |
|
915 if ($ThisCategory le $aCat) { next; } |
|
916 } |
|
917 $ThisCategory = uc($1); |
|
918 $CatSet = 1; |
|
919 next; |
|
920 } |
|
921 |
|
922 if ($_ =~ /authorized\s+(\w+)\s*(.*)/) # AUTHORIZED statements |
|
923 { |
|
924 my $aRec = lc($1); |
|
925 my $Rest = $2; |
|
926 my $found = 0; |
|
927 my $ShipUntil = 0; |
|
928 my $Repeat = 0; |
|
929 my @Recipients = keys(%ShipData); |
|
930 foreach my $name (@Recipients) |
|
931 { |
|
932 if ($aRec eq $name) |
|
933 { |
|
934 $Repeat = 1; |
|
935 &ErrorLoc("repeated recipient \"$aRec\"", $ThisLine, $Location); |
|
936 last; |
|
937 } |
|
938 } |
|
939 if ($Rest =~ /until\s+(\d+)\W(\d+)\W(\d+)/) # UNTIL Authorized qualifier |
|
940 { |
|
941 my $D = $1; |
|
942 my $M = $2; |
|
943 my $Y = $3; |
|
944 $ShipUntil = $Y*10000 + $M*100 + $D; |
|
945 if (not &IsValidDate($D, $M, $Y)) |
|
946 { |
|
947 &ErrorLoc("illegal date \"$D/$M/$Y\"", $ThisLine, $Location); |
|
948 $ShipUntil = $Now - 1; |
|
949 } |
|
950 } |
|
951 else |
|
952 { |
|
953 if ($Rest =~ /\w+/) |
|
954 { |
|
955 &ErrorLoc("unknown \"Authorized\" qualifier: \"$Rest\"", $ThisLine, $Location); |
|
956 $ShipUntil = $Now - 1; |
|
957 } |
|
958 } |
|
959 if ((!$ShipData{$aRec}) or ($ShipData{$aRec} > $ShipUntil)) |
|
960 { |
|
961 $ShipData{$aRec} = $ShipUntil; |
|
962 } |
|
963 next; |
|
964 } |
|
965 |
|
966 if ($_ =~ /expires\s+(\d+)\W(\d+)\W(\d+)/) # EXPIRES statements |
|
967 { |
|
968 my $D = $1; |
|
969 my $M = $2; |
|
970 my $Y = $3; |
|
971 my $E = $Y*10000 + $M*100 + $D; |
|
972 if (not &IsValidDate($D, $M, $Y)) |
|
973 { |
|
974 &ErrorLoc("illegal date \"$D/$M/$Y\"", $ThisLine, $Location); |
|
975 $E = $Now - 1; |
|
976 next; |
|
977 } |
|
978 if ((!$Expiry) or ($Expiry > $E)) |
|
979 { |
|
980 $Expiry = $E; |
|
981 } |
|
982 next; |
|
983 } |
|
984 |
|
985 if ($_ =~ /export\s+(\w*)restricted/) # EXPORT statements |
|
986 { |
|
987 if ($1 ne 'un') { $Restricted = 1; } |
|
988 next; |
|
989 } |
|
990 |
|
991 if ($_ =~ /description\s+(.*)/) # DESCRIPTION statements |
|
992 { |
|
993 $Description = $1; |
|
994 next; |
|
995 } |
|
996 |
|
997 if ($_ =~ /^\s*osd/) # Ignore OSD: statements |
|
998 { |
|
999 next; |
|
1000 } |
|
1001 |
|
1002 if ($_ =~ /\S/) # Anything else |
|
1003 { |
|
1004 $_ =~ /(.*)$/; |
|
1005 &ErrorLoc("unrecognised statement \"$1\"", $ThisLine, $Location); |
|
1006 } |
|
1007 } |
|
1008 close(IPR); |
|
1009 |
|
1010 if (!$CatSet) |
|
1011 { |
|
1012 &ErrorLoc("missing Category statement", $ThisLine, $Location); |
|
1013 } |
|
1014 else |
|
1015 { |
|
1016 if ((scalar keys %ShipData != 0) and ($ThisCategory =~ /[^B-C]/i)) |
|
1017 { |
|
1018 &NotifyError("category $ThisCategory source should not name recipients"); |
|
1019 } |
|
1020 } |
|
1021 return ($ThisCategory, $Expiry, $Restricted, $Description, %ShipData); |
|
1022 } |
|
1023 |
|
1024 sub Today |
|
1025 { |
|
1026 my ($Sec, $Min, $Hr, $Daym, $Mnth, $Yr, $Wkday, %YrDay, $IsDST) = localtime(time); |
|
1027 return (($Yr+1900)*10000+($Mnth+1)*100+$Daym); |
|
1028 } |
|
1029 |
|
1030 sub IsValidDate |
|
1031 { |
|
1032 my $Dy = shift; |
|
1033 my $Mth = shift; |
|
1034 my $Yr = shift; |
|
1035 if ($Yr < 1900) { return 0; } |
|
1036 if (($Mth < 1) or ($Mth > 12)) { return 0; } |
|
1037 if (($Dy <1) or ($Dy > &DayinMonth($Mth, &IsLeap($Yr)))) { return 0; } |
|
1038 return 1; |
|
1039 } |
|
1040 |
|
1041 sub IsLeap |
|
1042 { |
|
1043 my $aYear = shift; |
|
1044 return (!($aYear%4) && ($aYear%100 || !($aYear%400))) ? 1 : 0; |
|
1045 } |
|
1046 |
|
1047 sub DayinMonth |
|
1048 { |
|
1049 my @dim = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, |
|
1050 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); |
|
1051 |
|
1052 my $Monthnum = shift; |
|
1053 my $Leap = shift; |
|
1054 return $dim[$Leap*12 + $Monthnum - 1]; |
|
1055 } |
|
1056 |
|
1057 sub DateValToStr |
|
1058 { |
|
1059 my $Date = shift; |
|
1060 my $temp = $Date%100; |
|
1061 my $DatStr = "$temp\/"; |
|
1062 $Date -= $temp; |
|
1063 $Date /= 100; |
|
1064 $temp = $Date%100; |
|
1065 $DatStr .="$temp\/"; |
|
1066 $Date -= $temp; |
|
1067 $Date /= 100; |
|
1068 $DatStr .= "$Date"; |
|
1069 } |
|
1070 |
|
1071 sub DataPrint |
|
1072 { |
|
1073 if ($Full >= -1) |
|
1074 { |
|
1075 print @_; |
|
1076 } |
|
1077 } |
|
1078 |
|
1079 sub PkgPrint |
|
1080 { |
|
1081 print PKGLIST @_; |
|
1082 } |
|
1083 |
|
1084 sub MfsPrint |
|
1085 { |
|
1086 my $mfsname = uc $_[0]; |
|
1087 print MFSLIST "$mfsname"; |
|
1088 } |
|
1089 |
|
1090 sub ErrorLoc |
|
1091 { |
|
1092 my $msg = shift; |
|
1093 my $line = shift; |
|
1094 my $loc = shift; |
|
1095 &NotifyError("$msg"); |
|
1096 &ErrorPrint(" in line $line of $loc"); |
|
1097 } |
|
1098 |
|
1099 sub NotifyError |
|
1100 { |
|
1101 my $msg = shift; |
|
1102 &ErrorPrint("ERROR: $msg"); |
|
1103 } |
|
1104 |
|
1105 sub NotifyWarning |
|
1106 { |
|
1107 my $msg = shift; |
|
1108 &ErrorPrint("WARNING: $msg"); |
|
1109 } |
|
1110 |
|
1111 sub NotifyNote |
|
1112 { |
|
1113 my $msg = shift; |
|
1114 &ErrorPrint("Note: $msg"); |
|
1115 } |
|
1116 |
|
1117 sub ErrorPrint |
|
1118 { |
|
1119 my $msg = shift; |
|
1120 print STDERR "$msg\n"; |
|
1121 } |
|
1122 |
|
1123 sub ExportWarning |
|
1124 { |
|
1125 print STDERR <<ENDEXPORTSTRING; |
|
1126 WARNING: The selected code contains export-restricted source. |
|
1127 Any external release must contain the following notice. |
|
1128 |
|
1129 "The delivery of this software is subject to UK Export Control and is made |
|
1130 under Open Individual Export Licence (OIEL) no OIEL I/006318/99, which covers |
|
1131 Sweden, USA, Japan, Finland and Hungary. The recipient of this software agrees |
|
1132 that it will not export or re-export the software directly or indirectly to any |
|
1133 country which at the time of export requires an export licence or other |
|
1134 governmental approval, without first obtaining such licence or approval." |
|
1135 |
|
1136 ENDEXPORTSTRING |
|
1137 } |
|
1138 |
|
1139 sub ConditionalRep |
|
1140 { |
|
1141 my $Found = shift; |
|
1142 my $Path = shift; |
|
1143 my $Cat = shift; |
|
1144 my $Expire = shift; |
|
1145 my $NoExp = shift; |
|
1146 my $Description = shift; |
|
1147 my %LDates = @_; |
|
1148 |
|
1149 if (index($Categories, $Cat) < 0) { return; } |
|
1150 if ($NoExp and !$ForceExport) { return; } |
|
1151 if ($NoExp) { $IncludesRestrictedSource = 1; } |
|
1152 my $Printed = 0; |
|
1153 |
|
1154 if ($Full > 1) # write one line of tab-separated data per directory |
|
1155 { |
|
1156 if ($Found) |
|
1157 { |
|
1158 my @Recipients; |
|
1159 my $NamePrinted = 0; |
|
1160 &DataPrint ("$Path\t", "$Cat\t"); # directory and category |
|
1161 if ($NoExp) { &DataPrint ('Restricted'); } # export status |
|
1162 &DataPrint ("\t"); |
|
1163 @Recipients = keys(%LDates); |
|
1164 foreach my $name (@Recipients) # comma-separated list of recipients |
|
1165 { |
|
1166 if ($NamePrinted) |
|
1167 { |
|
1168 &DataPrint (', '); |
|
1169 } |
|
1170 &DataPrint ($name); |
|
1171 $NamePrinted = 1; |
|
1172 } |
|
1173 &DataPrint ("\t"); |
|
1174 @Recipients = keys(%LDates); # earliest of any expiry dates |
|
1175 foreach my $name (@Recipients) |
|
1176 { |
|
1177 my $Date = $LDates{$name}; |
|
1178 if ($Date) |
|
1179 { |
|
1180 if (($Expire <= 0) or ($Date < $Expire)) |
|
1181 { |
|
1182 $Expire = $Date; |
|
1183 } |
|
1184 } |
|
1185 } |
|
1186 if ($Expire > 0) |
|
1187 { |
|
1188 my $Str = &DateValToStr($Expire); |
|
1189 &DataPrint ("$Str"); |
|
1190 } |
|
1191 &DataPrint ("\t"); |
|
1192 &DataPrint ("$Description\n"); # show descriptive text, if it exists |
|
1193 } |
|
1194 } |
|
1195 |
|
1196 else # use a multi-line report format |
|
1197 { |
|
1198 if ($Found or ($Full >= 0)) |
|
1199 { |
|
1200 &DataPrint ("Directory: $Path\n"); |
|
1201 } |
|
1202 |
|
1203 if ($Full >= 0) |
|
1204 { |
|
1205 if (!$Found) |
|
1206 { |
|
1207 &DataPrint ("No files\n\n"); |
|
1208 return; |
|
1209 } |
|
1210 &DataPrint ("Category $Cat\n"); |
|
1211 $Printed = 1; |
|
1212 } |
|
1213 if (($Full > 0) or ($NoExp)) # Always report inclusion of export restricted code |
|
1214 { |
|
1215 my $Str = "Export "; |
|
1216 $Str .= $NoExp ? "restricted" : "unrestricted"; |
|
1217 &DataPrint ("$Str\n"); |
|
1218 } |
|
1219 if ($Full > 0) |
|
1220 { |
|
1221 if ($Expire > 0) |
|
1222 { |
|
1223 my $Str = &DateValToStr($Expire); |
|
1224 &DataPrint ("Expires on $Str\n"); |
|
1225 $Printed = 1; |
|
1226 } |
|
1227 my @Recipients = keys(%LDates); |
|
1228 foreach my $name (@Recipients) |
|
1229 { |
|
1230 my $Str = "Can ship to ".ucfirst($name); |
|
1231 my $Date = $LDates{$name}; |
|
1232 if ($Date) |
|
1233 { |
|
1234 $Str .= " until "; |
|
1235 $Str .= &DateValToStr($Date); |
|
1236 } |
|
1237 &DataPrint ("$Str\n"); |
|
1238 $Printed = 1; |
|
1239 if ($name eq $Recipient) { $Expire = $LDates{$name}; } |
|
1240 } |
|
1241 } |
|
1242 } |
|
1243 if ($ShowFiles or $Zip or $GenPkg or $Manifest) |
|
1244 { |
|
1245 my @flist; |
|
1246 my $name; |
|
1247 my $shippable; |
|
1248 |
|
1249 return if (&HasExpired($Expire) and !$OverrideExpiry) ; |
|
1250 |
|
1251 if (!&CanShip($Recipient, keys(%LDates))) |
|
1252 { |
|
1253 if ($ShowFiles) |
|
1254 { |
|
1255 &DataPrint (" Files not shippable to $Recipient\n\n"); |
|
1256 } |
|
1257 return; |
|
1258 } |
|
1259 |
|
1260 opendir(HERE, $Path); |
|
1261 @flist = readdir(HERE); |
|
1262 close(HERE); |
|
1263 foreach my $name (@flist) |
|
1264 { |
|
1265 if (-d "$Path$name") { next; } |
|
1266 if ($ShowFiles) |
|
1267 { |
|
1268 &DataPrint (" $Path$name\n"); |
|
1269 $Printed = 1; |
|
1270 } |
|
1271 |
|
1272 if ($GenPkg) |
|
1273 { |
|
1274 # -------------------------- |
|
1275 # print filespec to Pkg file |
|
1276 # -------------------------- |
|
1277 &PkgPrint (" <item src=\"$Path$name\" dest=\"[sdkroot]$Path$name\"\/>\n"); |
|
1278 } |
|
1279 |
|
1280 if ($Manifest) |
|
1281 { |
|
1282 # -------------------------- |
|
1283 # print filespec to manifest file |
|
1284 # -------------------------- |
|
1285 &MfsPrint (" $Path$name\n"); |
|
1286 } |
|
1287 |
|
1288 if ($Zip) |
|
1289 { |
|
1290 if ($Cat eq 'A') |
|
1291 { |
|
1292 $ZippedCatA = 1; |
|
1293 } |
|
1294 if ($Cat eq 'X') |
|
1295 { |
|
1296 $ZippedCatX = 1; |
|
1297 } |
|
1298 print ZIPLIST "$Path$name\n" or die "Can't write to $ZipTmpFile\n"; |
|
1299 } |
|
1300 } |
|
1301 } |
|
1302 if ($Printed) { &DataPrint ("\n"); } |
|
1303 } |
|
1304 |
|
1305 sub CanShip |
|
1306 { |
|
1307 my $to = shift; |
|
1308 my @list = @_; |
|
1309 my $count; |
|
1310 my $name; |
|
1311 |
|
1312 return (1) if ($to eq 'all'); |
|
1313 $count = @list; |
|
1314 if ($count) |
|
1315 { |
|
1316 return (0) if ($to eq 'generic'); |
|
1317 foreach my $name (@list) |
|
1318 { |
|
1319 return(1) if ($to eq $name); |
|
1320 } |
|
1321 return(0); |
|
1322 } |
|
1323 return(1); |
|
1324 } |
|
1325 |
|
1326 sub ReadDirFile |
|
1327 { |
|
1328 my $filename = shift; |
|
1329 my @dlist; |
|
1330 |
|
1331 open(DIRLIST, $filename) or die "Can't open $filename\n"; |
|
1332 while (<DIRLIST>) |
|
1333 { |
|
1334 $_ = lc $_; |
|
1335 s/\s*#.*$//; # remove comments |
|
1336 s/\s*$//; # remove trailing whitespace |
|
1337 if ($_ =~ /^$/) { next; } # ignore blank lines |
|
1338 if (-d $_) # entry is a valid directory |
|
1339 { |
|
1340 push(@dlist, $_); |
|
1341 next; |
|
1342 } |
|
1343 else |
|
1344 { |
|
1345 &NotifyError("Unrecognised directory \"$_\" in \"$filename\" ignored"); |
|
1346 } |
|
1347 } |
|
1348 close DIRLIST; |
|
1349 @dlist; |
|
1350 } |
|
1351 |
|
1352 sub HasExpired |
|
1353 { |
|
1354 my $date = shift; |
|
1355 return ($date and ($date < $Now)) |
|
1356 } |
|
1357 |
|
1358 sub Strip |
|
1359 { |
|
1360 # Remove excess occurrences of '..' and '.' from a path |
|
1361 return undef unless $_[0]=~m-^\\-o; # Must start with backslash |
|
1362 my $P=$_[0]; |
|
1363 $P=~s-^\\\.{2}$-\\-o; # Convert plain "\.." to "\" We are at the root anyway; can't go any higher! |
|
1364 $P=~s-\\\.$-\\-o; # Remove backslash-dot from end of line |
|
1365 $P=~s-\\(?!\.{2}\\)[^\\]*\\\.{2}$-\\-o; # Catch dotdot at end of text. Remove last directory. |
|
1366 while ($P=~s-\\\.\\-\\-go) { } # Convert backslash-dot-backslash to backslash |
|
1367 while ($P=~s-\\(?!\.{2}\\)[^\\]*\\\.{2}(?=\\)--go) { } # Convert backslash-fname-backslash-dotdot-backslash to backslash |
|
1368 $P; |
|
1369 } |
|
1370 |
|
1371 sub Split |
|
1372 { |
|
1373 # return the section of a file path required - Path, Base, Ext or File |
|
1374 my ($Sect,$P)=@_; |
|
1375 $Sect=ucfirst lc $Sect; |
|
1376 if ($Sect eq 'Path') |
|
1377 { |
|
1378 if ($P=~/^(.*\\)/o) |
|
1379 { |
|
1380 return $1; |
|
1381 } |
|
1382 return ''; |
|
1383 } |
|
1384 if ($Sect eq 'Base') |
|
1385 { |
|
1386 if ($P=~/\\?([^\\]*?)(\.[^\\\.]*)?$/o) |
|
1387 { |
|
1388 return $1; |
|
1389 } |
|
1390 return ''; |
|
1391 } |
|
1392 if ($Sect eq 'Ext') |
|
1393 { |
|
1394 if ($P=~/(\.[^\\\.]*)$/o) |
|
1395 { |
|
1396 return $1; |
|
1397 } |
|
1398 return ''; |
|
1399 } |
|
1400 if ($Sect eq 'File') |
|
1401 { |
|
1402 if ($P=~/([^\\]*)$/o) |
|
1403 { |
|
1404 return $1; |
|
1405 } |
|
1406 return ''; |
|
1407 } |
|
1408 undef; |
|
1409 } |
|
1410 |
|
1411 sub ValidateExcPath |
|
1412 { |
|
1413 my $p = $_[0]; |
|
1414 if ((!(-e $p))) |
|
1415 { |
|
1416 &NotifyWarning("Unrecognised exclusion directory \"$p\" will be ignored"); |
|
1417 return undef; |
|
1418 } |
|
1419 $p=~s-^(.*[^\\])$-$1\\-o; # ensure it ends with a backslash |
|
1420 $p; |
|
1421 } |
|
1422 |
|
1423 sub ValidateIncPath |
|
1424 { |
|
1425 my $p = $_[0]; |
|
1426 if ((!(-e $p))) |
|
1427 { |
|
1428 &NotifyWarning("Unrecognised inclusion directory \"$p\" will be ignored"); |
|
1429 return undef; |
|
1430 } |
|
1431 $p=~s-^(.*[^\\])$-$1\\-o; # ensure it ends with a backslash |
|
1432 $p; |
|
1433 } |
|
1434 |
|
1435 sub MakeAbs |
|
1436 { |
|
1437 return undef unless $_[0]=~m-^\\-o; # Ensure that $Path begins with backslash, i.e. starts from root |
|
1438 my ($Path,@List)=@_; |
|
1439 my $BasePath=&Split("Path",$Path); |
|
1440 undef $Path; |
|
1441 my $p; |
|
1442 foreach $p (@List) |
|
1443 { |
|
1444 if ($p=~m-^\.{1,2}-o) # Directory == "." or ".."? |
|
1445 { |
|
1446 $p=&Strip($BasePath.$p); |
|
1447 next; |
|
1448 } |
|
1449 if ($p=~m-(^.:)-o) # Directory starts with drive-letter: |
|
1450 { |
|
1451 if (uc $1 eq $WorkDrv) {next;}; # Allow current drive for backward compatability. |
|
1452 print "Drive specifications not supported\n"; |
|
1453 exit 1; |
|
1454 } |
|
1455 if ($p=~m-^[^\.\\]-o) # Directory does not start with dot or backslash |
|
1456 { |
|
1457 $p=$BasePath.$p; |
|
1458 next; |
|
1459 } |
|
1460 if ($p=~m-^\\-o) # Directory starts with a backslash |
|
1461 { |
|
1462 next; |
|
1463 } |
|
1464 if ($p=~m-^\.\\(.*)$-o) # Directory starts with a dot, then a backslash. What's left becomes $1 |
|
1465 { |
|
1466 $p=&Strip($BasePath.$1); |
|
1467 next; |
|
1468 } |
|
1469 return undef; # None of the above |
|
1470 } |
|
1471 return @List; |
|
1472 } |
|
1473 |
|
1474 sub FindZip |
|
1475 { |
|
1476 my $PathList = $ENV{ 'PATH' }; |
|
1477 my (@PathSplit) = split( ";",$PathList ); |
|
1478 |
|
1479 if ( -e ( $WorkPath."zip.exe" ) ) # Check current directory first |
|
1480 { |
|
1481 return 1; |
|
1482 } |
|
1483 foreach my $p ( @PathSplit ) |
|
1484 { |
|
1485 if ( -e ( $p."\\zip.exe" ) ) |
|
1486 { |
|
1487 return 1; |
|
1488 } |
|
1489 } |
|
1490 return 0; |
|
1491 } |
|
1492 |
|
1493 sub Usage |
|
1494 { |
|
1495 print <<ENDHERESTRING; |
|
1496 IPRTOOL.PL Version 1.41 Copyright (c) 2000, 2001 Symbian Ltd. |
|
1497 All rights reserved |
|
1498 Usage: |
|
1499 perl iprtool.pl [options] [help|?] |
|
1500 |
|
1501 where options are: |
|
1502 -c[ats] ABCDEFGIOTX report the listed categories (default: EFGOT) |
|
1503 -d[ir] <path>[<file>] start scan at the specified directory; if a file |
|
1504 specification, scan all directories listed in the |
|
1505 file (defaults to the current working directory) |
|
1506 -e[xport] include files subject to DTI export restrictions |
|
1507 -f[ull] [2|1|0|-1|-2] set the extent of the summary of the content of |
|
1508 the policy file for each directory: |
|
1509 2 one line of tab-separated data per directory |
|
1510 1 full policy data for each directory |
|
1511 0 directory name and category (the default) |
|
1512 -1 no IPR information |
|
1513 -2 suppress all summary output, except errors |
|
1514 -g[enpkg] <pkgfile> create an XML package file for the selected files |
|
1515 -l[icensee] <IDstr> specify a recipient by name (not code name) |
|
1516 -m[anifest] <outfile> write a file list in manifest format to <outfile> |
|
1517 -n[osub] do not include subdirectories in the report |
|
1518 -o[verrideexpiry] include source whose expiry date is in the past |
|
1519 -p[roject] <prj> include specific source directories listed in |
|
1520 <prj>.extra (overrides any exclusions) |
|
1521 -r[eport] <product> produces an ASCII and a HTML report on the syntax |
|
1522 and semantics of all the distribution policy files |
|
1523 -s[howfiles] list the files in each reported directory |
|
1524 -x[clude] <path>[<file>] specify head(s) of whole directory tree(s) to |
|
1525 exclude from the scan (format as for the -d flag) |
|
1526 -z[ip] <zipfile> create a zipfile of the selected files |
|
1527 |
|
1528 ----------------------------------------------------------------------------- |
|
1529 |
|
1530 This tool provides the ability to create zips of selected source and/or to |
|
1531 construct reports, either for external distribution or for internal audit |
|
1532 purposes. |
|
1533 |
|
1534 The types of report available include: |
|
1535 |
|
1536 · a full description of the IPR status of each directory |
|
1537 · a listing of all directories containing code of a specified category or set of categories |
|
1538 |
|
1539 In each case the report may refer to one or more specific directories, with or without their included subdirectories, or the whole source directory tree. |
|
1540 |
|
1541 Command line options are: |
|
1542 Option Action Default See Note |
|
1543 -c[ats] <catIDs> restrict report to the specified category or categories, where <catIDs> can be any combination of one or more of A, B, C, D, E, F, G and X report all categories 5 |
|
1544 -d[ir] <path>[<file name>] start scan at the specified directory or, if a file specification, scan all directories listed in the file start scan at the current directory 2, 3 |
|
1545 -e[xport] include files that are subject to DTI export restrictions don’t include export-restricted files |
|
1546 -f[ull] 2|1|0|-1|-2 set extent of the summary of the content of the policy file for each directory: |
|
1547 2 one line of tab-separated |
|
1548 data per directory |
|
1549 1 full, multi-line |
|
1550 0 reduced (the default) |
|
1551 -1 no IPR data, directory |
|
1552 names only |
|
1553 -2 suppress all output other |
|
1554 than error reports reduced - report the directory name and category |
|
1555 -g[enpkg] <pkgfile> create an XML package file for the selected files don’t create an XML package file |
|
1556 -l[icensee] <Idstr> specify a particular recipient assume a ‘generic’ recipient 1 |
|
1557 -m[anifest] <outfile> write a file list in manifest format to <outfile> don’t create a manifest listing |
|
1558 -n[osub] do not include subdirectories in the report include subdirectories |
|
1559 -o[verrideexpiry] include source whose expiry date is in the past obey expiry dates |
|
1560 -p[roject] <prjname> specify a particular project, to |
|
1561 enable the inclusion of |
|
1562 additional category D source no additional source 4 |
|
1563 -s[howfiles] list the files in each reported directory don’t list files |
|
1564 -x[clude] <path>[<file name>] exclude the specified directory and its subdirectories or, if a file specification, exclude all directory trees headed by the directories listed in the file no exclusions 2, 3 |
|
1565 -z[ip] <zipfile name> create a zipfile of the selected (reported) files create a report without zipping |
|
1566 |
|
1567 Notes |
|
1568 1) The convention is that true company names are to be used, not codenames. It is recommended that the name does not include spaces. Names are not validated. |
|
1569 Category B and C source code whose policy file contains Authorized statement(s) will not be included in a zip unless unless an Authorized statement name matches with the Licensee name specified by means of the -l flag. |
|
1570 Filtering of licensee-specific source may be overridden by specifying '-l all'. This should only be used for construction of internal deliveries which need to include source owned by multiple licensees. |
|
1571 |
|
1572 2) An example of the content of a directory list file for use with the -d or -x flags is: |
|
1573 |
|
1574 # Example directory listing for use with iprtool.pl |
|
1575 |
|
1576 \\hal |
|
1577 \\e32toolp |
|
1578 |
|
1579 Directories may be listed with absolute paths, as above, or relative paths. Paths are always interpreted with respect to the current working directory, regardless of the location af the directory list file. Do NOT include drive letter. |
|
1580 |
|
1581 3) Absolute paths used with the -d and -x flags, and within directory list files, may include drive letters, but their use is not recommended without good reason A valid reason to include a drive letter with the -d or -x flag is if a directory list file needs to be stored outside the drive that is being scanned. It is unlikely that there will ever be a valid reason to include drive letters in the paths listed in a directory listing file. |
|
1582 |
|
1583 4) If a project is specified with the -p flag, and a file with the name '<prjname>.extra' is found in the directory from which the tool is run, the report is extended to include the content of all directories listed in that file (reported as though the -n flag were set, so all subdirectories need to be listed). A source file zip will not include category B an C source that is excluded as described in Note 1. Otherwise, this mechanism unconditionally includes the content of all listed directories, regardless of their category, export status or expiry date, and overriding any directories excluded by means of the -x flag. The following is a fictitious example file 'calypso.extra' |
|
1584 |
|
1585 # Additional source directories for Calypso project deliveries |
|
1586 |
|
1587 \\rcomp |
|
1588 \\rcomp\\group |
|
1589 |
|
1590 5) Category X is exceptional. Uncategorised code - ie source in a directory without a distribution.policy file, or with a policy file that does not contain a valid Category statement - is reported as being in category X. No source should be actively classified as category X; any attempt to do so will be reported as an error by the tool. |
|
1591 Errors and warnings |
|
1592 The tool reports (to STDERR) errors and warnings that are found while scanning source directories. The most significant error notification is of missing policy files but the tool also reports on a wide variety of errors in the content of the policy files. Such errors include unrecognised keywords, unexpected duplicate keywords and illegal dates. |
|
1593 |
|
1594 Warnings are also issued if a source zip includes source that is in category A or is uncategorised (cat X), or is subject to export restrictions. |
|
1595 |
|
1596 ENDHERESTRING |
|
1597 exit 1; |
|
1598 } |
|