diff options
Diffstat (limited to 'dynamic-layers/meta-perl/recipes-security/bastille/files/FileContent.pm')
-rw-r--r-- | dynamic-layers/meta-perl/recipes-security/bastille/files/FileContent.pm | 1153 |
1 files changed, 1153 insertions, 0 deletions
diff --git a/dynamic-layers/meta-perl/recipes-security/bastille/files/FileContent.pm b/dynamic-layers/meta-perl/recipes-security/bastille/files/FileContent.pm new file mode 100644 index 0000000..1ef89dd --- /dev/null +++ b/dynamic-layers/meta-perl/recipes-security/bastille/files/FileContent.pm | |||
@@ -0,0 +1,1153 @@ | |||
1 | package Bastille::API::FileContent; | ||
2 | use strict; | ||
3 | |||
4 | use Bastille::API; | ||
5 | |||
6 | require Exporter; | ||
7 | our @ISA = qw(Exporter); | ||
8 | our @EXPORT_OK = qw( | ||
9 | B_blank_file | ||
10 | B_insert_line_after | ||
11 | B_insert_line_before | ||
12 | B_insert_line | ||
13 | B:append_line | ||
14 | B:prepend_line | ||
15 | B_replace_line | ||
16 | B_replace_lines | ||
17 | B_replace_pattern | ||
18 | B_match_line | ||
19 | B_match_line_only | ||
20 | B_match_chunk | ||
21 | B_return_matched_lines | ||
22 | B_hash_comment_line | ||
23 | B_hash_uncomment_line | ||
24 | B_delete_line | ||
25 | B_chunk_replace | ||
26 | B_print | ||
27 | B_getValueFromFile | ||
28 | B_getValueFromString | ||
29 | |||
30 | B_TODO | ||
31 | B_TODOFlags | ||
32 | ); | ||
33 | our @EXPORT = @EXPORT_OK; | ||
34 | |||
35 | |||
36 | |||
37 | ########################################################################### | ||
38 | # &B_blank_file ($filename,$pattern) blanks the file $filename, unless the | ||
39 | # pattern $pattern is present in the file. This lets us completely redo | ||
40 | # a file, if it isn't the one we put in place on a previous run... | ||
41 | # | ||
42 | # B_blank_file respects $GLOBAL_LOGONLY and uses B_open_plus and B_close_plus | ||
43 | # so that it makes backups and only modifies files when we're not in "-v" | ||
44 | # mode... | ||
45 | # | ||
46 | # If the file does not exist, the function does nothing, and gives an error | ||
47 | # to the Error Log | ||
48 | # | ||
49 | ########################################################################### | ||
50 | |||
51 | sub B_blank_file($$) { | ||
52 | |||
53 | my ($filename,$pattern) = @_; | ||
54 | my $retval; | ||
55 | |||
56 | # If this variable is true, we won't blank the file... | ||
57 | |||
58 | my $found_pattern=0; | ||
59 | |||
60 | if ($retval=&B_open_plus (*BLANK_NEW,*BLANK_OLD,$filename) ) { | ||
61 | |||
62 | my @lines; | ||
63 | |||
64 | while (my $line = <BLANK_OLD>) { | ||
65 | |||
66 | push @lines,$line; | ||
67 | if ($line =~ $pattern) { | ||
68 | $found_pattern=1; | ||
69 | } | ||
70 | } | ||
71 | |||
72 | # Only copy the old file if the new one didn't match. | ||
73 | if ($found_pattern) { | ||
74 | while ( my $line = shift @lines ) { | ||
75 | &B_print(*BLANK_NEW,$line); | ||
76 | } | ||
77 | } | ||
78 | else { | ||
79 | &B_log("ACTION","Blanked file $filename\n"); | ||
80 | } | ||
81 | &B_close_plus(*BLANK_NEW,*BLANK_OLD,$filename); | ||
82 | } | ||
83 | else { | ||
84 | &B_log("ERROR","Couldn't blank file $filename since we couldn't open it or its replacement\n"); | ||
85 | } | ||
86 | |||
87 | return $retval; | ||
88 | |||
89 | } | ||
90 | |||
91 | ########################################################################### | ||
92 | # &B_insert_line_after ($filename,$pattern,$line_to_insert,$line_to_follow) | ||
93 | # modifies $filename, inserting $line_to_insert unless one or more lines | ||
94 | # in the file matches $pattern. The $line_to_insert will be placed | ||
95 | # immediately after $line_to_follow, if it exists. If said line does not | ||
96 | # exist, the line will not be inserted and this routine will return 0. | ||
97 | # | ||
98 | # B_insert_line uses B_open_plus and B_close_plus, so that the file | ||
99 | # modified is backed up... | ||
100 | # | ||
101 | # Here's examples of where you might use this: | ||
102 | # | ||
103 | # You'd like to insert a line in Apache's configuration file, in a | ||
104 | # particular section. | ||
105 | # | ||
106 | ########################################################################### | ||
107 | |||
108 | sub B_insert_line_after($$$$) { | ||
109 | |||
110 | my ($filename,$pattern,$line_to_insert,$line_to_follow) = @_; | ||
111 | |||
112 | my @lines; | ||
113 | my $found_pattern=0; | ||
114 | my $found_line_to_follow=0; | ||
115 | |||
116 | my $retval=1; | ||
117 | |||
118 | if ( &B_open_plus (*INSERT_NEW,*INSERT_OLD,$filename) ) { | ||
119 | |||
120 | # Read through the file looking for a match both on the $pattern | ||
121 | # and the line we are supposed to be inserting after... | ||
122 | |||
123 | my $ctr=1; | ||
124 | while (my $line=<INSERT_OLD>) { | ||
125 | push (@lines,$line); | ||
126 | if ($line =~ $pattern) { | ||
127 | $found_pattern=1; | ||
128 | } | ||
129 | if ( ($found_line_to_follow < 1) and ($line =~ $line_to_follow)) { | ||
130 | $found_line_to_follow=$ctr; | ||
131 | } | ||
132 | $ctr++; | ||
133 | } | ||
134 | |||
135 | # Log an error if we never found the line we were to insert after | ||
136 | unless ($found_line_to_follow ) { | ||
137 | $retval=0; | ||
138 | &B_log("ERROR","Never found the line that we were supposed to insert after in $filename\n"); | ||
139 | } | ||
140 | |||
141 | # Now print the file back out, inserting our line if we should... | ||
142 | |||
143 | $ctr=1; | ||
144 | while (my $line = shift @lines) { | ||
145 | &B_print(*INSERT_NEW,$line); | ||
146 | if ( ($ctr == $found_line_to_follow) and ($found_pattern == 0) ) { | ||
147 | &B_print(*INSERT_NEW,$line_to_insert); | ||
148 | &B_log("ACTION","Inserted the following line in $filename:\n"); | ||
149 | &B_log("ACTION","$line_to_insert"); | ||
150 | } | ||
151 | $ctr++; | ||
152 | } | ||
153 | |||
154 | &B_close_plus (*INSERT_NEW,*INSERT_OLD,$filename); | ||
155 | |||
156 | } | ||
157 | else { | ||
158 | $retval=0; | ||
159 | &B_log("ERROR","Couldn't insert line to $filename, since open failed."); | ||
160 | } | ||
161 | |||
162 | return $retval; | ||
163 | |||
164 | } | ||
165 | ########################################################################### | ||
166 | # &B_insert_line_before ($filename,$pattern,$line_to_insert,$line_to_preceed) | ||
167 | # modifies $filename, inserting $line_to_insert unless one or more lines | ||
168 | # in the file matches $pattern. The $line_to_insert will be placed | ||
169 | # immediately before $line_to_preceed, if it exists. If said line does not | ||
170 | # exist, the line will not be inserted and this routine will return 0. | ||
171 | # | ||
172 | # B_insert_line uses B_open_plus and B_close_plus, so that the file | ||
173 | # modified is backed up... | ||
174 | # | ||
175 | # Here's examples of where you might use this: | ||
176 | # | ||
177 | # You'd like to insert a line in Apache's configuration file, in a | ||
178 | # particular section. | ||
179 | # | ||
180 | ########################################################################### | ||
181 | |||
182 | sub B_insert_line_before($$$$) { | ||
183 | |||
184 | my ($filename,$pattern,$line_to_insert,$line_to_preceed) = @_; | ||
185 | |||
186 | my @lines; | ||
187 | my $found_pattern=0; | ||
188 | my $found_line_to_preceed=0; | ||
189 | |||
190 | my $retval=1; | ||
191 | |||
192 | if ( &B_open_plus (*INSERT_NEW,*INSERT_OLD,$filename) ) { | ||
193 | |||
194 | # Read through the file looking for a match both on the $pattern | ||
195 | # and the line we are supposed to be inserting after... | ||
196 | |||
197 | my $ctr=1; | ||
198 | while (my $line=<INSERT_OLD>) { | ||
199 | push (@lines,$line); | ||
200 | if ($line =~ $pattern) { | ||
201 | $found_pattern=1; | ||
202 | } | ||
203 | if ( ($found_line_to_preceed < 1) and ($line =~ $line_to_preceed)) { | ||
204 | $found_line_to_preceed=$ctr; | ||
205 | } | ||
206 | $ctr++; | ||
207 | } | ||
208 | |||
209 | # Log an error if we never found the line we were to preceed | ||
210 | unless ($found_line_to_preceed ) { | ||
211 | $retval=0; | ||
212 | &B_log("ERROR","Never found the line that we were supposed to insert before in $filename\n"); | ||
213 | } | ||
214 | |||
215 | # Now print the file back out, inserting our line if we should... | ||
216 | |||
217 | $ctr=1; | ||
218 | while (my $line = shift @lines) { | ||
219 | if ( ($ctr == $found_line_to_preceed) and ($found_pattern == 0) ) { | ||
220 | &B_print(*INSERT_NEW,$line_to_insert); | ||
221 | &B_log("ACTION","Inserted the following line in $filename:\n"); | ||
222 | &B_log("ACTION","$line_to_insert"); | ||
223 | } | ||
224 | &B_print(*INSERT_NEW,$line); | ||
225 | $ctr++; | ||
226 | } | ||
227 | |||
228 | &B_close_plus (*INSERT_NEW,*INSERT_OLD,$filename); | ||
229 | |||
230 | } | ||
231 | else { | ||
232 | $retval=0; | ||
233 | &B_log("ERROR","Couldn't insert line to $filename, since open failed."); | ||
234 | } | ||
235 | |||
236 | return $retval; | ||
237 | |||
238 | } | ||
239 | |||
240 | ########################################################################### | ||
241 | # &B_insert_line ($filename,$pattern,$line_to_insert,$line_to_follow) | ||
242 | # | ||
243 | # has been renamed to B_insert_line_after() | ||
244 | # | ||
245 | # This name will continue to work, as a shim for code that has not been | ||
246 | # transitioned. | ||
247 | ########################################################################### | ||
248 | |||
249 | sub B_insert_line($$$$) { | ||
250 | |||
251 | my $rtn_value = &B_insert_line_after(@_); | ||
252 | |||
253 | return ($rtn_value); | ||
254 | } | ||
255 | |||
256 | |||
257 | ########################################################################### | ||
258 | # &B_append_line ($filename,$pattern,$line_to_append) modifies $filename, | ||
259 | # appending $line_to_append unless one or more lines in the file matches | ||
260 | # $pattern. This is an enhancement to the append_line_if_no_such_line_exists | ||
261 | # idea. | ||
262 | # | ||
263 | # Additionally, if $pattern is set equal to "", the line is always appended. | ||
264 | # | ||
265 | # B:append_line uses B_open_plus and B_close_plus, so that the file | ||
266 | # modified is backed up... | ||
267 | # | ||
268 | # Here's examples of where you might use this: | ||
269 | # | ||
270 | # You'd like to add a root line to /etc/ftpusers if none exists. | ||
271 | # You'd like to add a Options Indexes line to Apache's config. file, | ||
272 | # after you delete all Options lines from said config file. | ||
273 | # | ||
274 | ########################################################################### | ||
275 | |||
276 | sub B:append_line($$$) { | ||
277 | |||
278 | my ($filename,$pattern,$line_to_append) = @_; | ||
279 | |||
280 | my $found_pattern=0; | ||
281 | my $retval=1; | ||
282 | |||
283 | if ( &B_open_plus (*APPEND_NEW,*APPEND_OLD,$filename) ) { | ||
284 | while (my $line=<APPEND_OLD>) { | ||
285 | &B_print(*APPEND_NEW,$line); | ||
286 | if ($line =~ $pattern) { | ||
287 | $found_pattern=1; | ||
288 | } | ||
289 | } | ||
290 | # Changed != 0 to $pattern so that "" works instead of 0 and perl | ||
291 | # does not give the annoying | ||
292 | # Argument "XX" isn't numeric in ne at ... | ||
293 | if ( $pattern eq "" or ! $found_pattern ) { | ||
294 | &B_print(*APPEND_NEW,$line_to_append); | ||
295 | &B_log("ACTION","Appended the following line to $filename:\n"); | ||
296 | &B_log("ACTION","$line_to_append"); | ||
297 | } | ||
298 | &B_close_plus (*APPEND_NEW,*APPEND_OLD,$filename); | ||
299 | } | ||
300 | else { | ||
301 | $retval=0; | ||
302 | &B_log("ERROR","# Couldn't append line to $filename, since open failed."); | ||
303 | } | ||
304 | |||
305 | return $retval; | ||
306 | |||
307 | } | ||
308 | |||
309 | ########################################################################### | ||
310 | # &B_prepend_line ($filename,$pattern,$line_to_prepend) modifies $filename, | ||
311 | # pre-pending $line_to:prepend unless one or more lines in the file matches | ||
312 | # $pattern. This is an enhancement to the prepend_line_if_no_such_line_exists | ||
313 | # idea. | ||
314 | # | ||
315 | # B:prepend_line uses B_open_plus and B_close_plus, so that the file | ||
316 | # modified is backed up... | ||
317 | # | ||
318 | # Here's examples of where you might use this: | ||
319 | # | ||
320 | # You'd like to insert the line "auth required pam_deny.so" to the top | ||
321 | # of the PAM stack file /etc/pam.d/rsh to totally deactivate rsh. | ||
322 | # | ||
323 | ########################################################################### | ||
324 | |||
325 | sub B:prepend_line($$$) { | ||
326 | |||
327 | my ($filename,$pattern,$line_to_prepend) = @_; | ||
328 | |||
329 | my @lines; | ||
330 | my $found_pattern=0; | ||
331 | my $retval=1; | ||
332 | |||
333 | if ( &B_open_plus (*PREPEND_NEW,*PREPEND_OLD,$filename) ) { | ||
334 | while (my $line=<PREPEND_OLD>) { | ||
335 | push (@lines,$line); | ||
336 | if ($line =~ $pattern) { | ||
337 | $found_pattern=1; | ||
338 | } | ||
339 | } | ||
340 | unless ($found_pattern) { | ||
341 | &B_print(*PREPEND_NEW,$line_to_prepend); | ||
342 | } | ||
343 | while (my $line = shift @lines) { | ||
344 | &B_print(*PREPEND_NEW,$line); | ||
345 | } | ||
346 | |||
347 | &B_close_plus (*PREPEND_NEW,*PREPEND_OLD,$filename); | ||
348 | |||
349 | # Log the action | ||
350 | &B_log("ACTION","Pre-pended the following line to $filename:\n"); | ||
351 | &B_log("ACTION","$line_to:prepend"); | ||
352 | } | ||
353 | else { | ||
354 | $retval=0; | ||
355 | &B_log("ERROR","Couldn't prepend line to $filename, since open failed.\n"); | ||
356 | } | ||
357 | |||
358 | return $retval; | ||
359 | |||
360 | } | ||
361 | |||
362 | |||
363 | ########################################################################### | ||
364 | # &B_replace_line ($filename,$pattern,$line_to_switch_in) modifies $filename, | ||
365 | # replacing any lines matching $pattern with $line_to_switch_in. | ||
366 | # | ||
367 | # It returns the number of lines it replaced (or would have replaced, if | ||
368 | # LOGONLY mode wasn't on...) | ||
369 | # | ||
370 | # B_replace_line uses B_open_plus and B_close_plus, so that the file | ||
371 | # modified is backed up... | ||
372 | # | ||
373 | # Here an example of where you might use this: | ||
374 | # | ||
375 | # You'd like to replace any Options lines in Apache's config file with: | ||
376 | # Options Indexes FollowSymLinks | ||
377 | # | ||
378 | ########################################################################### | ||
379 | |||
380 | sub B_replace_line($$$) { | ||
381 | |||
382 | my ($filename,$pattern,$line_to_switch_in) = @_; | ||
383 | my $retval=0; | ||
384 | |||
385 | if ( &B_open_plus (*REPLACE_NEW,*REPLACE_OLD,$filename) ) { | ||
386 | while (my $line=<REPLACE_OLD>) { | ||
387 | unless ($line =~ $pattern) { | ||
388 | &B_print(*REPLACE_NEW,$line); | ||
389 | } | ||
390 | else { | ||
391 | # Don't replace the line if it's already there. | ||
392 | unless ($line eq $line_to_switch_in) { | ||
393 | &B_print(*REPLACE_NEW,$line_to_switch_in); | ||
394 | |||
395 | $retval++; | ||
396 | &B_log("ACTION","File modification in $filename -- replaced line\n" . | ||
397 | "$line\n" . | ||
398 | "with:\n" . | ||
399 | "$line_to_switch_in"); | ||
400 | } | ||
401 | # But if it is there, make sure it stays there! (by Paul Allen) | ||
402 | else { | ||
403 | &B_print(*REPLACE_NEW,$line); | ||
404 | } | ||
405 | } | ||
406 | } | ||
407 | &B_close_plus (*REPLACE_NEW,*REPLACE_OLD,$filename); | ||
408 | } | ||
409 | else { | ||
410 | $retval=0; | ||
411 | &B_log("ERROR","Couldn't replace line(s) in $filename because open failed.\n"); | ||
412 | } | ||
413 | |||
414 | return $retval; | ||
415 | } | ||
416 | |||
417 | ########################################################################### | ||
418 | # &B_replace_lines ($filename,$patterns_and_substitutes) modifies $filename, | ||
419 | # replacing the line matching the nth $pattern specified in $patterns_and_substitutes->[n]->[0] | ||
420 | # with the corresponding substitutes in $patterns_and_substitutes->[n]->-[1] | ||
421 | # | ||
422 | # It returns the number of lines it replaced (or would have replaced, if | ||
423 | # LOGONLY mode wasn't on...) | ||
424 | # | ||
425 | # B_replace_lines uses B_open_plus and B_close_plus, so that the file | ||
426 | # modified is backed up... | ||
427 | # | ||
428 | # Here an example of where you might use this: | ||
429 | # | ||
430 | # You'd like to replace /etc/opt/ssh/sshd_config file | ||
431 | # (^#|^)Protocol\s+(.*)\s*$ ==> Protocol 2 | ||
432 | # (^#|^)X11Forwarding\s+(.*)\s*$ ==> X11Forwarding yes | ||
433 | # (^#|^)IgnoreRhosts\s+(.*)\s*$ ==> gnoreRhosts yes | ||
434 | # (^#|^)RhostsAuthentication\s+(.*)\s*$ ==> RhostsAuthentication no | ||
435 | # (^#|^)RhostsRSAAuthentication\s+(.*)\s*$ ==> RhostsRSAAuthentication no | ||
436 | # (^#|^)PermitRootLogin\s+(.*)\s*$ ==> PermitRootLogin no | ||
437 | # (^#|^)PermitEmptyPasswords\s+(.*)\s*$ ==> PermitEmptyPasswords no | ||
438 | # my $patterns_and_substitutes = [ | ||
439 | # [ '(^#|^)Protocol\s+(.*)\s*$' => 'Protocol 2'], | ||
440 | # ['(^#|^)X11Forwarding\s+(.*)\s*$' => 'X11Forwarding yes'], | ||
441 | # ['(^#|^)IgnoreRhosts\s+(.*)\s*$' => 'gnoreRhosts yes'], | ||
442 | # ['(^#|^)RhostsAuthentication\s+(.*)\s*$' => 'RhostsAuthentication no'], | ||
443 | # ['(^#|^)RhostsRSAAuthentication\s+(.*)\s*$' => 'RhostsRSAAuthentication no'], | ||
444 | # ['(^#|^)PermitRootLogin\s+(.*)\s*$' => 'PermitRootLogin no'], | ||
445 | # ['(^#|^)PermitEmptyPasswords\s+(.*)\s*$' => 'PermitEmptyPasswords no'] | ||
446 | #] | ||
447 | # B_replaces_lines($sshd_config,$patterns_and_substitutes); | ||
448 | ########################################################################### | ||
449 | |||
450 | sub B_replace_lines($$){ | ||
451 | my ($filename, $pairs) = @_; | ||
452 | my $retval = 0; | ||
453 | if ( &B_open_plus (*REPLACE_NEW,*REPLACE_OLD,$filename) ) { | ||
454 | while (my $line = <REPLACE_OLD>) { | ||
455 | my $switch; | ||
456 | my $switch_before = $line; | ||
457 | chomp($line); | ||
458 | foreach my $pair (@$pairs) { | ||
459 | $switch = 0; | ||
460 | |||
461 | my $pattern = $pair->[0] ; | ||
462 | my $replace = $pair->[1]; | ||
463 | my $evalstr = '$line' . "=~ s/$pattern/$replace/"; | ||
464 | eval $evalstr; | ||
465 | if ($@) { | ||
466 | &B_log("ERROR", "eval $evalstr failed.\n"); | ||
467 | } | ||
468 | #if ( $line =~ s/$pair->[0]/$pair->[1]/) { | ||
469 | # $switch = 1; | ||
470 | # last; | ||
471 | #} | ||
472 | } | ||
473 | &B_print(*REPLACE_NEW,"$line\n"); | ||
474 | if ($switch) { | ||
475 | $retval++; | ||
476 | B_log("ACTION","File modification in $filename -- replaced line\n" . | ||
477 | "$switch_before\n" . | ||
478 | "with:\n" . | ||
479 | "$line\n"); | ||
480 | } | ||
481 | } | ||
482 | &B_close_plus (*REPLACE_NEW,*REPLACE_OLD,$filename); | ||
483 | return 1; | ||
484 | } | ||
485 | else { | ||
486 | $retval=0; | ||
487 | &B_log("ERROR","Couldn't replace line(s) in $filename because open failed.\n"); | ||
488 | } | ||
489 | } | ||
490 | |||
491 | ################################################################################################ | ||
492 | # &B_replace_pattern ($filename,$pattern,$pattern_to_remove,$text_to_switch_in) | ||
493 | # modifies $filename, acting on only lines that match $pattern, replacing a | ||
494 | # string that matches $pattern_to_remove with $text_to_switch_in. | ||
495 | # | ||
496 | # Ex: | ||
497 | # B_replace_pattern('/etc/httpd.conf','^\s*Options.*\bIncludes\b','Includes','IncludesNoExec') | ||
498 | # | ||
499 | # replaces all "Includes" with "IncludesNoExec" on Apache Options lines. | ||
500 | # | ||
501 | # It returns the number of lines it altered (or would have replaced, if | ||
502 | # LOGONLY mode wasn't on...) | ||
503 | # | ||
504 | # B_replace_pattern uses B_open_plus and B_close_plus, so that the file | ||
505 | # modified is backed up... | ||
506 | # | ||
507 | ################################################################################################# | ||
508 | |||
509 | sub B_replace_pattern($$$$) { | ||
510 | |||
511 | my ($filename,$pattern,$pattern_to_remove,$text_to_switch_in) = @_; | ||
512 | my $retval=0; | ||
513 | |||
514 | if ( &B_open_plus (*REPLACE_NEW,*REPLACE_OLD,$filename) ) { | ||
515 | while (my $line=<REPLACE_OLD>) { | ||
516 | unless ($line =~ $pattern) { | ||
517 | &B_print(*REPLACE_NEW,$line); | ||
518 | } | ||
519 | else { | ||
520 | my $orig_line =$line; | ||
521 | $line =~ s/$pattern_to_remove/$text_to_switch_in/; | ||
522 | |||
523 | &B_print(*REPLACE_NEW,$line); | ||
524 | |||
525 | $retval++; | ||
526 | &B_log("ACTION","File modification in $filename -- replaced line\n" . | ||
527 | "$orig_line\n" . | ||
528 | "via pattern with:\n" . | ||
529 | "$line\n\n"); | ||
530 | } | ||
531 | } | ||
532 | &B_close_plus (*REPLACE_NEW,*REPLACE_OLD,$filename); | ||
533 | } | ||
534 | else { | ||
535 | $retval=0; | ||
536 | &B_log("ERROR","Couldn't pattern-replace line(s) in $filename because open failed.\n"); | ||
537 | } | ||
538 | |||
539 | return $retval; | ||
540 | } | ||
541 | |||
542 | |||
543 | ########################################################################### | ||
544 | # &B_match_line($file,$pattern); | ||
545 | # | ||
546 | # This subroutine will return a 1 if the pattern specified can be matched | ||
547 | # against the file specified. It will return a 0 otherwise. | ||
548 | # | ||
549 | # return values: | ||
550 | # 0: pattern not in file or the file is not readable | ||
551 | # 1: pattern is in file | ||
552 | ########################################################################### | ||
553 | sub B_match_line($$) { | ||
554 | # file to be checked and pattern to check for. | ||
555 | my ($file,$pattern) = @_; | ||
556 | # if the file is readable then | ||
557 | if(-r $file) { | ||
558 | # if the file can be opened then | ||
559 | if(open FILE,"<$file") { | ||
560 | # look at each line in the file | ||
561 | while (my $line = <FILE>) { | ||
562 | # if a line matches the pattern provided then | ||
563 | if($line =~ $pattern) { | ||
564 | # return the pattern was found | ||
565 | B_log('DEBUG','Pattern: ' . $pattern . ' matched in file: ' . | ||
566 | $file . "\n"); | ||
567 | return 1; | ||
568 | } | ||
569 | } | ||
570 | } | ||
571 | # if the file cann't be opened then | ||
572 | else { | ||
573 | # send a note to that affect to the errorlog | ||
574 | &B_log("ERROR","Unable to open file for read.\n$file\n$!\n"); | ||
575 | } | ||
576 | } | ||
577 | B_log('DEBUG','Pattern: ' . $pattern . ' not matched in file: ' . | ||
578 | $file . "\n"); | ||
579 | # the provided pattern was not matched against a line in the file | ||
580 | return 0; | ||
581 | } | ||
582 | |||
583 | ########################################################################### | ||
584 | # &B_match_line_only($file,$pattern); | ||
585 | # | ||
586 | # This subroutine checks if the specified pattern can be matched and if | ||
587 | # it's the only content in the file. The only content means it's only but | ||
588 | # may have several copies in the file. | ||
589 | # | ||
590 | # return values: | ||
591 | # 0: pattern not in file or pattern is not the only content | ||
592 | # or the file is not readable | ||
593 | # 1: pattern is in file and it's the only content | ||
594 | ############################################################################ | ||
595 | sub B_match_line_only($$) { | ||
596 | my ($file,$pattern) = @_; | ||
597 | |||
598 | # if matched, set to 1 later | ||
599 | my $retval = 0; | ||
600 | |||
601 | # if the file is readable then | ||
602 | if(-r $file) { | ||
603 | # if the file can be opened then | ||
604 | if(&B_open(*FILED, $file)) { | ||
605 | # pattern should be matched at least once | ||
606 | # pattern can not be mismatched | ||
607 | while (my $line = <FILED>) { | ||
608 | if ($line =~ $pattern) { | ||
609 | $retval = 1; | ||
610 | } | ||
611 | else { | ||
612 | &B_close(*FILED); | ||
613 | return 0; | ||
614 | } | ||
615 | } | ||
616 | } | ||
617 | &B_close(*FILED); | ||
618 | } | ||
619 | |||
620 | return $retval; | ||
621 | } | ||
622 | |||
623 | ########################################################################### | ||
624 | # &B_return_matched_lines($file,$pattern); | ||
625 | # | ||
626 | # This subroutine returns lines in a file matching a given regular | ||
627 | # expression, when called in the default list mode. When called in scalar | ||
628 | # mode, returns the number of elements found. | ||
629 | ########################################################################### | ||
630 | sub B_return_matched_lines($$) | ||
631 | { | ||
632 | my ($filename,$pattern) = @_; | ||
633 | my @lines = (); | ||
634 | |||
635 | open(READFILE, $filename); | ||
636 | while (<READFILE>) { | ||
637 | chomp; | ||
638 | next unless /$pattern/; | ||
639 | push(@lines, $_); | ||
640 | } | ||
641 | if (wantarray) | ||
642 | { | ||
643 | return @lines; | ||
644 | } | ||
645 | else | ||
646 | { | ||
647 | return scalar (@lines); | ||
648 | } | ||
649 | } | ||
650 | |||
651 | ########################################################################### | ||
652 | # &B_match_chunk($file,$pattern); | ||
653 | # | ||
654 | # This subroutine will return a 1 if the pattern specified can be matched | ||
655 | # against the file specified on a line-agnostic form. This allows for | ||
656 | # patterns which by necessity must match against a multi-line pattern. | ||
657 | # This is the natural analogue to B_replace_chunk, which was created to | ||
658 | # provide multi-line capability not provided by B_replace_line. | ||
659 | # | ||
660 | # return values: | ||
661 | # 0: pattern not in file or the file is not readable | ||
662 | # 1: pattern is in file | ||
663 | ########################################################################### | ||
664 | |||
665 | sub B_match_chunk($$) { | ||
666 | |||
667 | my ($file,$pattern) = @_; | ||
668 | my @lines; | ||
669 | my $big_long_line; | ||
670 | my $retval=1; | ||
671 | |||
672 | open CHUNK_FILE,$file; | ||
673 | |||
674 | # Read all lines into one scalar. | ||
675 | @lines = <CHUNK_FILE>; | ||
676 | close CHUNK_FILE; | ||
677 | |||
678 | foreach my $line ( @lines ) { | ||
679 | $big_long_line .= $line; | ||
680 | } | ||
681 | |||
682 | # Substitution routines get weird unless last line is terminated with \n | ||
683 | chomp $big_long_line; | ||
684 | $big_long_line .= "\n"; | ||
685 | |||
686 | # Exit if we don't find a match | ||
687 | unless ($big_long_line =~ $pattern) { | ||
688 | $retval = 0; | ||
689 | } | ||
690 | |||
691 | return $retval; | ||
692 | } | ||
693 | |||
694 | ########################################################################### | ||
695 | # &B_hash_comment_line ($filename,$pattern) modifies $filename, replacing | ||
696 | # any lines matching $pattern with a "hash-commented" version, like this: | ||
697 | # | ||
698 | # | ||
699 | # finger stream tcp nowait nobody /usr/sbin/tcpd in.fingerd | ||
700 | # becomes: | ||
701 | # #finger stream tcp nowait nobody /usr/sbin/tcpd in.fingerd | ||
702 | # | ||
703 | # Also: | ||
704 | # tftp dgram udp wait root /usr/lbin/tftpd tftpd\ | ||
705 | # /opt/ignite\ | ||
706 | # /var/opt/ignite | ||
707 | # becomes: | ||
708 | # #tftp dgram udp wait root /usr/lbin/tftpd tftpd\ | ||
709 | # # /opt/ignite\ | ||
710 | # # /var/opt/ignite | ||
711 | # | ||
712 | # | ||
713 | # B_hash_comment_line uses B_open_plus and B_close_plus, so that the file | ||
714 | # modified is backed up... | ||
715 | # | ||
716 | ########################################################################### | ||
717 | |||
718 | sub B_hash_comment_line($$) { | ||
719 | |||
720 | my ($filename,$pattern) = @_; | ||
721 | my $retval=1; | ||
722 | |||
723 | if ( &B_open_plus (*HASH_NEW,*HASH_OLD,$filename) ) { | ||
724 | my $line; | ||
725 | while ($line=<HASH_OLD>) { | ||
726 | unless ( ($line =~ $pattern) and ($line !~ /^\s*\#/) ) { | ||
727 | &B_print(*HASH_NEW,$line); | ||
728 | } | ||
729 | else { | ||
730 | &B_print(*HASH_NEW,"#$line"); | ||
731 | &B_log("ACTION","File modification in $filename -- hash commented line\n" . | ||
732 | "$line\n" . | ||
733 | "like this:\n" . | ||
734 | "#$line\n\n"); | ||
735 | # while the line has a trailing \ then we should also comment out the line below | ||
736 | while($line =~ m/\\\n$/) { | ||
737 | if($line=<HASH_OLD>) { | ||
738 | &B_print(*HASH_NEW,"#$line"); | ||
739 | &B_log("ACTION","File modification in $filename -- hash commented line\n" . | ||
740 | "$line\n" . | ||
741 | "like this:\n" . | ||
742 | "#$line\n\n"); | ||
743 | } | ||
744 | else { | ||
745 | $line = ""; | ||
746 | } | ||
747 | } | ||
748 | |||
749 | } | ||
750 | } | ||
751 | &B_close_plus (*HASH_NEW,*HASH_OLD,$filename); | ||
752 | } | ||
753 | else { | ||
754 | $retval=0; | ||
755 | &B_log("ERROR","Couldn't hash-comment line(s) in $filename because open failed.\n"); | ||
756 | } | ||
757 | |||
758 | return $retval; | ||
759 | } | ||
760 | |||
761 | |||
762 | ########################################################################### | ||
763 | # &B_hash_uncomment_line ($filename,$pattern) modifies $filename, | ||
764 | # removing any commenting from lines that match $pattern. | ||
765 | # | ||
766 | # #finger stream tcp nowait nobody /usr/sbin/tcpd in.fingerd | ||
767 | # becomes: | ||
768 | # finger stream tcp nowait nobody /usr/sbin/tcpd in.fingerd | ||
769 | # | ||
770 | # | ||
771 | # B_hash_uncomment_line uses B_open_plus and B_close_plus, so that the file | ||
772 | # modified is backed up... | ||
773 | # | ||
774 | ########################################################################### | ||
775 | |||
776 | sub B_hash_uncomment_line($$) { | ||
777 | |||
778 | my ($filename,$pattern) = @_; | ||
779 | my $retval=1; | ||
780 | |||
781 | if ( &B_open_plus (*HASH_NEW,*HASH_OLD,$filename) ) { | ||
782 | my $line; | ||
783 | while ($line=<HASH_OLD>) { | ||
784 | unless ( ($line =~ $pattern) and ($line =~ /^\s*\#/) ) { | ||
785 | &B_print(*HASH_NEW,$line); | ||
786 | } | ||
787 | else { | ||
788 | $line =~ /^\s*\#+(.*)$/; | ||
789 | $line = "$1\n"; | ||
790 | |||
791 | &B_print(*HASH_NEW,"$line"); | ||
792 | &B_log("ACTION","File modification in $filename -- hash uncommented line\n"); | ||
793 | &B_log("ACTION",$line); | ||
794 | # while the line has a trailing \ then we should also uncomment out the line below | ||
795 | while($line =~ m/\\\n$/) { | ||
796 | if($line=<HASH_OLD>) { | ||
797 | $line =~ /^\s*\#+(.*)$/; | ||
798 | $line = "$1\n"; | ||
799 | &B_print(*HASH_NEW,"$line"); | ||
800 | &B_log("ACTION","File modification in $filename -- hash uncommented line\n"); | ||
801 | &B_log("ACTION","#$line"); | ||
802 | &B_log("ACTION","like this:\n"); | ||
803 | &B_log("ACTION","$line"); | ||
804 | } | ||
805 | else { | ||
806 | $line = ""; | ||
807 | } | ||
808 | } | ||
809 | } | ||
810 | } | ||
811 | &B_close_plus (*HASH_NEW,*HASH_OLD,$filename); | ||
812 | } | ||
813 | else { | ||
814 | $retval=0; | ||
815 | &B_log("ERROR","Couldn't hash-uncomment line(s) in $filename because open failed.\n"); | ||
816 | } | ||
817 | |||
818 | return $retval; | ||
819 | } | ||
820 | |||
821 | |||
822 | |||
823 | ########################################################################### | ||
824 | # &B_delete_line ($filename,$pattern) modifies $filename, deleting any | ||
825 | # lines matching $pattern. It uses B_replace_line to do this. | ||
826 | # | ||
827 | # B_replace_line uses B_open_plus and B_close_plus, so that the file | ||
828 | # modified is backed up... | ||
829 | # | ||
830 | # Here an example of where you might use this: | ||
831 | # | ||
832 | # You'd like to remove any timeout= lines in /etc/lilo.conf, so that your | ||
833 | # delay=1 modification will work. | ||
834 | |||
835 | # | ||
836 | ########################################################################### | ||
837 | |||
838 | |||
839 | sub B_delete_line($$) { | ||
840 | |||
841 | my ($filename,$pattern)=@_; | ||
842 | my $retval=&B_replace_line($filename,$pattern,""); | ||
843 | |||
844 | return $retval; | ||
845 | } | ||
846 | |||
847 | |||
848 | ########################################################################### | ||
849 | # &B_chunk_replace ($file,$pattern,$replacement) reads $file replacing the | ||
850 | # first occurrence of $pattern with $replacement. | ||
851 | # | ||
852 | ########################################################################### | ||
853 | |||
854 | sub B_chunk_replace($$$) { | ||
855 | |||
856 | my ($file,$pattern,$replacement) = @_; | ||
857 | |||
858 | my @lines; | ||
859 | my $big_long_line; | ||
860 | my $retval=1; | ||
861 | |||
862 | &B_open (*OLDFILE,$file); | ||
863 | |||
864 | # Read all lines into one scalar. | ||
865 | @lines = <OLDFILE>; | ||
866 | &B_close (*OLDFILE); | ||
867 | foreach my $line ( @lines ) { | ||
868 | $big_long_line .= $line; | ||
869 | } | ||
870 | |||
871 | # Substitution routines get weird unless last line is terminated with \n | ||
872 | chomp $big_long_line; | ||
873 | $big_long_line .= "\n"; | ||
874 | |||
875 | # Exit if we don't find a match | ||
876 | unless ($big_long_line =~ $pattern) { | ||
877 | return 0; | ||
878 | } | ||
879 | |||
880 | $big_long_line =~ s/$pattern/$replacement/s; | ||
881 | |||
882 | $retval=&B_open_plus (*NEWFILE,*OLDFILE,$file); | ||
883 | if ($retval) { | ||
884 | &B_print (*NEWFILE,$big_long_line); | ||
885 | &B_close_plus (*NEWFILE,*OLDFILE,$file); | ||
886 | } | ||
887 | |||
888 | return $retval; | ||
889 | } | ||
890 | |||
891 | ########################################################################### | ||
892 | # &B_print ($handle,@list) prints the items of @list to the file handle | ||
893 | # $handle. It logs the action and respects the $GLOBAL_LOGONLY variable. | ||
894 | # | ||
895 | ########################################################################### | ||
896 | |||
897 | sub B_print { | ||
898 | my $handle=shift @_; | ||
899 | |||
900 | my $result=1; | ||
901 | |||
902 | unless ($GLOBAL_LOGONLY) { | ||
903 | $result=print $handle @_; | ||
904 | } | ||
905 | |||
906 | ($handle) = "$handle" =~ /[^:]+::[^:]+::([^:]+)/; | ||
907 | |||
908 | $result; | ||
909 | } | ||
910 | |||
911 | |||
912 | ########################################################################## | ||
913 | # &B_getValueFromFile($regex,$file); | ||
914 | # Takes a regex with a single group "()" and returns the unique value | ||
915 | # on any non-commented lines | ||
916 | # This (and B_return_matched_lines are only used in this file, though are | ||
917 | # probably more generally useful. For now, leaving these here serve the following | ||
918 | #functions: | ||
919 | # a) still gets exported/associated as part of the Test_API package, and | ||
920 | # is still availble for a couple operations that can't be deferred to the | ||
921 | # main test loop, as they save values so that individual tests don't have to | ||
922 | # recreate (copy / paste) the logic to get them. | ||
923 | # | ||
924 | # It also avoids the circular "use" if we incldued "use Test API" at the top | ||
925 | # of this file (Test API "uses" this file. | ||
926 | # Returns the uncommented, unique values of a param=value pair. | ||
927 | # | ||
928 | # Return values: | ||
929 | # 'Not Defined' if the value is not present or not uniquely defined. | ||
930 | # $value if the value is present and unique | ||
931 | # | ||
932 | ########################################################################### | ||
933 | sub B_getValueFromFile ($$){ | ||
934 | my $inputRegex=$_[0]; | ||
935 | my $file=$_[1]; | ||
936 | my ($lastvalue,$value)=''; | ||
937 | |||
938 | my @lines=&B_return_matched_lines($file, $inputRegex); | ||
939 | |||
940 | return &B_getValueFromString($inputRegex,join('/n',@lines)); | ||
941 | } | ||
942 | |||
943 | ########################################################################## | ||
944 | # &B_getValueFromString($param,$string); | ||
945 | # Takes a regex with a single group "()" and returns the unique value | ||
946 | # on any non-commented lines | ||
947 | # This (and B_return_matched_lines are only used in this file, though are | ||
948 | # probably more generally useful. For now, leaving these here serve the following | ||
949 | #functions: | ||
950 | # a) still gets exported/associated as part of the Test_API package, and | ||
951 | # is still availble for a couple operations that can't be deferred to the | ||
952 | # main test loop, as they save values so that individual tests don't have to | ||
953 | # recreate (copy / paste) the logic to get them. | ||
954 | # | ||
955 | # It also avoids the circular "use" if we incldued "use Test API" at the top | ||
956 | # of this file (Test API "uses" this file. | ||
957 | # Returns the uncommented, unique values of a param=value pair. | ||
958 | # | ||
959 | # Return values: | ||
960 | # 'Not Unique' if the value is not uniquely defined. | ||
961 | # undef if the value isn't defined at all | ||
962 | # $value if the value is present and unique | ||
963 | # | ||
964 | ########################################################################### | ||
965 | sub B_getValueFromString ($$){ | ||
966 | my $inputRegex=$_[0]; | ||
967 | my $inputString=$_[1]; | ||
968 | my $lastValue=''; | ||
969 | my $value=''; | ||
970 | |||
971 | my @lines=split(/\n/,$inputString); | ||
972 | |||
973 | &B_log("DEBUG","B_getvaluefromstring called with regex: $inputRegex and input: " . | ||
974 | $inputString); | ||
975 | foreach my $line (grep(/$inputRegex/,@lines)) { | ||
976 | $line =~ /$inputRegex/; | ||
977 | $value=$1; | ||
978 | if (($lastValue eq '') and ($value ne '')) { | ||
979 | $lastValue = $value; | ||
980 | } elsif (($lastValue ne $value) and ($value ne '')) { | ||
981 | B_log("DEBUG","getvaluefromstring returned Not Unique"); | ||
982 | return 'Not Unique'; | ||
983 | } | ||
984 | } | ||
985 | if ((not(defined($value))) or ($value eq '')) { | ||
986 | &B_log("DEBUG","Could not find regex match in string"); | ||
987 | return undef; | ||
988 | } else { | ||
989 | &B_log("DEBUG","B_getValueFromString Found: $value ; using: $inputRegex"); | ||
990 | return $value; | ||
991 | } | ||
992 | } | ||
993 | |||
994 | ############################################################### | ||
995 | # This function adds something to the To Do List. | ||
996 | # Arguments: | ||
997 | # 1) The string you want to add to the To Do List. | ||
998 | # 2) Optional: Question whose TODOFlag should be set to indicate | ||
999 | # A pending manual action in subsequent reports. Only skip this | ||
1000 | # If there's no security-audit relevant action you need the user to | ||
1001 | # accomplish | ||
1002 | # Ex: | ||
1003 | # &B_TODO("------\nInstalling IPFilter\n----\nGo get Ipfilter","IPFilter.install_ipfilter"); | ||
1004 | # | ||
1005 | # | ||
1006 | # Returns: | ||
1007 | # 0 - If error condition | ||
1008 | # True, if sucess, specifically: | ||
1009 | # "appended" if the append operation was successful | ||
1010 | # "exists" if no change was made since the entry was already present | ||
1011 | ############################################################### | ||
1012 | sub B_TODO ($;$) { | ||
1013 | my $text = $_[0]; | ||
1014 | my $FlaggedQuestion = $_[1]; | ||
1015 | my $multilineString = ""; | ||
1016 | |||
1017 | # trim off any leading and trailing new lines, regexes separated for "clarity" | ||
1018 | $text =~ s/^\n+(.*)/$1/; | ||
1019 | $text =~ s/(.*)\n+$/$1/; | ||
1020 | |||
1021 | if ( ! -e &getGlobal('BFILE',"TODO") ) { | ||
1022 | # Make the TODO list file for HP-UX Distro | ||
1023 | &B_create_file(&getGlobal('BFILE', "TODO")); | ||
1024 | &B_append_line(&getGlobal('BFILE', "TODO"),'a$b', | ||
1025 | "Please take the steps below to make your system more secure,\n". | ||
1026 | "then delete the item from this file and record what you did along\n". | ||
1027 | "with the date and time in your system administration log. You\n". | ||
1028 | "will need that information in case you ever need to revert your\n". | ||
1029 | "changes.\n\n"); | ||
1030 | } | ||
1031 | |||
1032 | |||
1033 | if (open(TODO,"<" . &getGlobal('BFILE', "TODO"))) { | ||
1034 | while (my $line = <TODO>) { | ||
1035 | # getting rid of all meta characters. | ||
1036 | $line =~ s/(\\|\||\(|\)|\[|\]|\{|\}|\^|\$|\*|\+|\?|\.)//g; | ||
1037 | $multilineString .= $line; | ||
1038 | } | ||
1039 | chomp $multilineString; | ||
1040 | $multilineString .= "\n"; | ||
1041 | |||
1042 | close(TODO); | ||
1043 | } | ||
1044 | else { | ||
1045 | &B_log("ERROR","Unable to read TODO.txt file.\n" . | ||
1046 | "The following text could not be appended to the TODO list:\n" . | ||
1047 | $text . | ||
1048 | "End of TODO text\n"); | ||
1049 | return 0; #False | ||
1050 | } | ||
1051 | |||
1052 | my $textPattern = $text; | ||
1053 | |||
1054 | # getting rid of all meta characters. | ||
1055 | $textPattern =~ s/(\\|\||\(|\)|\[|\]|\{|\}|\^|\$|\*|\+|\?|\.)//g; | ||
1056 | |||
1057 | if( $multilineString !~ "$textPattern") { | ||
1058 | my $datestamp = "{" . localtime() . "}"; | ||
1059 | unless ( &B_append_line(&getGlobal('BFILE', "TODO"), "", $datestamp . "\n" . $text . "\n\n\n") ) { | ||
1060 | &B_log("ERROR","TODO Failed for text: " . $text ); | ||
1061 | } | ||
1062 | #Note that we only set the flag on the *initial* entry in the TODO File | ||
1063 | #Not on subsequent detection. This is to avoid the case where Bastille | ||
1064 | #complains on a subsequent Bastille run of an already-performed manual | ||
1065 | #action that the user neglected to delete from the TODO file. | ||
1066 | # It does, however lead to a report of "nonsecure" when the user | ||
1067 | #asked for the TODO item, performed it, Bastille detected that and cleared the | ||
1068 | # Item, and then the user unperformed the action. I think this is proper behavior. | ||
1069 | # rwf 06/06 | ||
1070 | |||
1071 | if (defined($FlaggedQuestion)) { | ||
1072 | &B_TODOFlags("set",$FlaggedQuestion); | ||
1073 | } | ||
1074 | return "appended"; #evals to true, and also notes what happened | ||
1075 | } else { | ||
1076 | return "exists"; #evals to true, and also | ||
1077 | } | ||
1078 | |||
1079 | } | ||
1080 | |||
1081 | |||
1082 | ##################################################################### | ||
1083 | # &B_TODOFlags() | ||
1084 | # | ||
1085 | # This is the interface to the TODO flags. Test functions set these when they | ||
1086 | # require a TODO item to be completed to get to a "secure" state. | ||
1087 | # The prune/reporting function checks these to ensure no flags are set before | ||
1088 | # reporting an item "secure" | ||
1089 | # "Methods" are load | save | isSet <Question> | set <Question> | unset <Question> | ||
1090 | # | ||
1091 | ###################################################################### | ||
1092 | |||
1093 | sub B_TODOFlags($;$) { | ||
1094 | my $action = $_[0]; | ||
1095 | my $module = $_[1]; | ||
1096 | |||
1097 | use File::Spec; | ||
1098 | |||
1099 | my $todo_flag = &getGlobal("BFILE","TODOFlag"); | ||
1100 | |||
1101 | &B_log("DEBUG","B_TODOFlags action: $action , module: $module"); | ||
1102 | |||
1103 | if ($action eq "load") { | ||
1104 | if (-e $todo_flag ) { | ||
1105 | &B_open(*TODO_FLAGS, $todo_flag); | ||
1106 | my @lines = <TODO_FLAGS>; | ||
1107 | foreach my $line (@lines) { | ||
1108 | chomp($line); | ||
1109 | $GLOBAL_CONFIG{"$line"}{"TODOFlag"}="yes"; | ||
1110 | } | ||
1111 | return (&B_close(*TODO_FLAGS)); #return success of final close | ||
1112 | } else { | ||
1113 | return 1; #No-op is okay | ||
1114 | } | ||
1115 | } elsif ($action eq "save") { | ||
1116 | # Make sure the file exists, else create | ||
1117 | #Note we use open_plus and and create file, so if Bastille is | ||
1118 | #reverted, all the flags will self-clear (file deleted) | ||
1119 | my $flagNumber = 0; | ||
1120 | my $flagData = ''; | ||
1121 | foreach my $key (keys %GLOBAL_CONFIG) { | ||
1122 | if ($GLOBAL_CONFIG{$key}{"TODOFlag"} eq "yes") { | ||
1123 | ++$flagNumber; | ||
1124 | $flagData .= "$key\n"; | ||
1125 | } | ||
1126 | } | ||
1127 | if (not( -e $todo_flag)) { | ||
1128 | &B_log("DEBUG","Initializing TODO Flag file: $todo_flag"); | ||
1129 | &B_create_file($todo_flag); # Make sure it exists | ||
1130 | } | ||
1131 | &B_blank_file($todo_flag, | ||
1132 | "This will not appear in the file; ensures blanking"); | ||
1133 | return &B_append_line($todo_flag, "", "$flagData"); #return success of save | ||
1134 | } elsif (($action eq "isSet") and ($module ne "")) { | ||
1135 | if ($GLOBAL_CONFIG{"$module"}{"TODOFlag"} eq "yes") { | ||
1136 | return 1; #TRUE | ||
1137 | } else { | ||
1138 | return 0; #FALSE | ||
1139 | } | ||
1140 | } elsif (($action eq "set") and ($module ne "")) { | ||
1141 | $GLOBAL_CONFIG{"$module"}{"TODOFlag"} = "yes"; | ||
1142 | } elsif (($action eq "clear") and ($module ne "")) { | ||
1143 | $GLOBAL_CONFIG{"$module"}{"TODOFlag"} = ""; | ||
1144 | } else { | ||
1145 | &B_log("ERROR","TODO_Flag Called with invalid parameters: $action , $module". | ||
1146 | "audit report may be incorrect."); | ||
1147 | return 0; #FALSE | ||
1148 | } | ||
1149 | } | ||
1150 | |||
1151 | 1; | ||
1152 | |||
1153 | |||