# $Id: Signature.pm 987 2005-01-08 01:04:43Z rwinslow $ # Read and parse a Bro signature from a string or array reference package Bro::Signature; use strict; require 5.006_001; use Bro::Config qw( $BRO_CONFIG ); require Exporter; use vars qw( $VERSION @ISA @EXPORT_OK %SKIP_OPT %ACTIONS $DEBUG ); $VERSION = 1.20; @EXPORT_OK = qw( findkeyblocks filelist getrules utctimenow ); @ISA = qw( Exporter ); $DEBUG = 0; # These conditions, actions, meta data will be skipped when comparing two # signature objects for differences. Reasons are given. %SKIP_OPT = ( 'active' => 1, # evaluated seperately '__raw_data__' => 1, # internal data '__value__' => 1, # internal data 'sig_id' => 1, # not evaluated '.revision' => 1, # evaluated seperately '.version' => 1, # evaluated seperately '.location' => 1, # reserved for editor use as a temporary field ); # Hash of valid actions in a signature. Currently there is only one. %ACTIONS = ( 'event' => 1, ); sub new { my $sub_name = 'new'; my $self; my $proto = shift; my $class = ref( $proto ) || $proto; my %args = @_; my $sig_data = {}; if( defined( $args{string} ) ) { if( !( $sig_data = parsesig( $args{string} ) ) ) { return( undef ); } } else { warn( __PACKAGE__ . "::$sub_name, Signature must be passed in as a string for now. Direct" . " object creation is not supported yet\n" ); return( undef ); } $self = $sig_data; bless( $self, $class ); if( $DEBUG > 1 ) { warn( $self->output() . "\n" ); } return( $self ); } sub parsesig { my $sub_name = 'parsesig'; my $sig_block = shift || return( undef ); my $sig_data; my $ret_data = {}; # Check on the storage of the data if( ref( $sig_block ) eq 'ARRAY' ) { $sig_data = join( "\n", @{$sig_block} ); } else { # Otherwise it gets treated as a string $sig_data = $sig_block; } # remove any leading or trailing white space $sig_data =~ s/^[[:space:]]*//; $sig_data =~ s/[[:space:]]*$//; my $parse_err = 0; if( $sig_data =~ m/^signature[[:space:]]+([[:alnum:]_-]+)[[:space:]]*\{[[:space:]\n]+ # signature declaration (.+?) # signature data [[:space:]]*\}$/xs ) # end of block { my $sig_id = $1; my $sig_options = $2; $ret_data->{sig_id} = $sig_id; my @raw_data; my $i = 0; foreach my $line( split( /\n/, $sig_options ) ) { # Each line of the signature is stored in an # array to maintain the order and any comments. # The actual data is stored in a hash. # Access of the data should be done through the methods # to output the whole signature along with comments. # remove any leading spaces $line =~ s/^[[:space:]]*//; # Put the line into the raw_data array $raw_data[$i] = $line; # Strip any comments from the line $line =~ s/(?:[[:space:]]+|)#.+$//; my( $key, $value ) = split( /[[:space:]]+/, $line, 2 ); # if there is still data in the line then process if( defined( $value ) ) { # Remove any leading spaces $value =~ s/^[[:space:]]*//; # place a reference to the raw_data array for this attribute # set the value for this attribute instance push( @{$ret_data->{$key}}, { '__raw_data_pos__' => $i, '__value__' => $value, }, ); } ++$i; } $ret_data->{'__raw_data__'} = \@raw_data; } else { if( $DEBUG > 0 ) { warn( __PACKAGE__ . "::$sub_name, Signature read error. Could not find a valid signature block\n" ); } $parse_err = 1; } if( $parse_err ) { return( undef ); } else { return( $ret_data ); } } sub findkeyblocks { my $sub_name = 'findkeyblocks'; my $string = $_[0]; my $keyword = 'signature'; my $key_len = length( $keyword ); my @ret_blocks; my $block_idx = 0; # Current idx of the keyword blocks that will be returned my $open_brace_count = 0; # Number of open braces encountered my $close_brace_count = 0; # number of close braces encountered my $len = length( $string ); # length of string passed in my $pos_idx = 0; # current position of substring my $st_blk_pos = 0; # string position of a new block my $blk_len = 0; # length of code block my $found_key_start = 0; # flag that a new keyword block has started my $comment_line = 0; # flag if comments are in effect my $quoted; # flag if quoting is active. contents are the quote character # make sure the string is of non-zero length. Add one more so our # loop below works if( $len > 0 ) { ++$len; } else { return( undef ); } # Push a newline onto the front of the string. This just helps in # starting the pattern matching. It's easier than writting a # bunch more lines of code. $string = "\n" . $string; ++$len; while( $pos_idx < $len ) { # If the two numbers match then a complete block has been found. if( $open_brace_count == $close_brace_count and $open_brace_count > 0 ) { $ret_blocks[$block_idx] = substr( $string, $st_blk_pos, $blk_len ); if( $DEBUG > 2 ) { my $end_pos = $st_blk_pos + $blk_len; warn( __PACKAGE__ . "::$sub_name, Found signature block between bytes $st_blk_pos and $end_pos\n" ); warn( $ret_blocks[$block_idx] . "\n" ); } ++$block_idx; $open_brace_count = 0; $close_brace_count = 0; $found_key_start = 0; $st_blk_pos = $pos_idx; $blk_len = 0; } elsif( $close_brace_count > $open_brace_count ) { # Looks like there was a syntax error perhaps the # file contains a keyword but no valid block # Reset the counters and backup to $st_blk_pos + 1 if( $DEBUG > 0 ) { warn( __PACKAGE__ . "::$sub_name, Error in parsing $keyword, found closed brace", " for a block but no open brace at char position $pos_idx\n" ); } $open_brace_count = 0; $close_brace_count = 0; $found_key_start = 0; $pos_idx = $st_blk_pos + 1; $st_blk_pos = ''; $blk_len = 0; next; } # Make sure that substr returns a value if( defined( my $wc = substr( $string, $pos_idx, 1 ) ) ) { if( $quoted and $found_key_start ) { if( $wc eq $quoted and substr( $string, $pos_idx - 1, 1 ) ne '\\' ) { $quoted = undef; } } # check for comment '#' character which is active until the # start of a newline elsif( ! $comment_line and $wc eq '#' and substr( $string, $pos_idx - 1, 1 ) ne '\\' ) { $comment_line = 1; } # Check if the comment flag is set elsif( $comment_line ) { # If the current character is a newline then reset the comment flag if( $wc =~ m/\n/ ) { $comment_line = 0; } } # start this if not currently working in a block and not a comment elsif( ! $found_key_start and ! $comment_line ) { # check if the keyword is found if( $pos_idx + $key_len + 1 < $len and substr( $string, $pos_idx, $key_len ) eq $keyword ) { # check to make sure that the keyword is followed by a space if( substr( $string, $pos_idx + $key_len, 1 ) =~ m/[[:space:]]/ ) { $found_key_start = 1; $st_blk_pos = $pos_idx; } } } # Need to re-think this one at some point though it's not going to kill things # to leave it out right now. # Check if a nested block has started. # elsif( $pos_idx + $key_len + 1 < $len # and $found_key_start # and substr( $string, $pos_idx, $key_len ) eq $keyword ) # { # if( substr( $string, $pos_idx + $key_len, 1 ) =~ # m/[[:space:]]/ ) # { # if( $DEBUG > 0 ) # { # warn( __PACKAGE__ . "::$sub_name, New $keyword keyword found inside of another $keyword block", # " at char position $pos_idx\n" ); # # #print "STRING => $string\n"; # } # # # Reset the search params # $open_brace_count = 0; # $close_brace_count = 0; # $found_key_start = 0; # ++$pos_idx; # $st_blk_pos = ''; # $blk_len = 0; # next; # } # } elsif( $wc eq '{' and substr( $string, $pos_idx - 1, 1 ) ne '\\' and substr( $string, $pos_idx + 1, 1 ) =~ m/[[:space:]\n]/ ) { ++$open_brace_count; } elsif( $wc eq '}' and substr( $string, $pos_idx - 1, 1 ) ne '\\' and substr( $string, $pos_idx - 1, 1 ) =~ m/[[:space:]\n]/ ) { ++$close_brace_count; } elsif( ! $quoted and ! $comment_line and $found_key_start ) { if( $wc eq '"' and substr( $string, $pos_idx - 1, 1 ) ne '\\' ) { $quoted = $wc; } } else { } # Only append chars to the working string if in a $keyword block if( $found_key_start ) { ++$blk_len; } ++$pos_idx; } else { warn( __PACKAGE__ . "::$sub_name, Failed to pull data out using substr at position $pos_idx\n" ); ++$pos_idx; } } if( wantarray ) { return( @ret_blocks ); } else { return( \@ret_blocks ); } } sub addcomment { my $sub_name = 'addcomment'; my $self = shift || return( undef ); my $comment = shift || return( undef ); # Make sure the comment starts with a '#' if( $comment !~ m/^[[:space:]]*#/ ) { $comment = '#' . $comment; } if( $self->{'__raw_data__'} ) { my $next_idx = $#{$self->{'__raw_data__'}} + 1; $self->{'__raw_data__'}->[$next_idx] = $comment; } else { return( undef ); } return( 1 ); } sub option { my $sub_name = 'option'; my $self = shift || return( undef ); my $sig_option = shift || return( undef ); my $ret_data; if( $self->{$sig_option} ) { foreach my $data( @{$self->{$sig_option}} ) { push( @{$ret_data}, $data->{'__value__'} ); } } else { return( undef ); } if( @{$ret_data} > 1 ) { return( @{$ret_data} ); } else { return( $ret_data->[0] ); } } sub addoption { my $sub_name = 'addoption'; my $self = shift || return( undef ); my $option = shift || return( undef ); my $option_data = shift || return( undef ); if( $self->{'__raw_data__'} ) { my $next_idx = $#{$self->{'__raw_data__'}} + 1; $self->{'__raw_data__'}->[$next_idx] = $option . ' ' . $option_data; push( @{$self->{$option}}, { '__raw_data_pos__' => $next_idx, '__value__' => $option_data, } ); } else { return( undef ); } return( 1 ); } sub modoption { my $sub_name = 'modoption'; # If successful the value which was replaced is returned. # If failure then an undefined value is returned. my $self = shift || return( undef ); my $match_option = shift || return( undef ); my $new_data = shift || return( undef ); my $match_data = shift; #optional my $replaced_data; if( exists( $self->{$match_option} ) ) { if( @{$self->{$match_option}} > 1 ) { # This won't work if $match_data is not defined if( ! defined( $match_data ) ) { if( $DEBUG > 0 ) { warn( __PACKAGE__ . "::$sub_name, Failed to modify option $match_option. Data which to match against is required for options with more than one instance.\n" ); } return( undef ); } foreach my $opt_inst( @{$self->{$match_option}} ) { if( $opt_inst->{'__value__'} eq $match_data ) { $replaced_data = $opt_inst->{'__value__'}; $opt_inst->{'__value__'} = $new_data; $self->{'__raw_data__'}->[$opt_inst->{'__raw_data_pos__'}] = "$match_option $new_data"; } } } else { $replaced_data = $self->{$match_option}->[0]->{'__value__'}; if( defined( $match_data ) and $match_data ne $replaced_data ) { return( undef ); } else { $self->{$match_option}->[0]->{'__value__'} = $new_data; $self->{'__raw_data__'}->[$self->{$match_option}->[0]->{'__raw_data_pos__'}] = "$match_option $new_data"; } } } else { # no matching option found return( undef ); } return( $replaced_data ); } sub deloption { my $sub_name = 'deloption'; # Accepts at a minimum the object and an option to remove # For options that have multivalues the value can be passed in as # option_data to remove only the one value from the object. # If an option has multivalues and no option_data is given then all # options are removed. my $self = shift || return( undef ); my $match_option = shift || return( undef ); my $match_data = shift; #optional my $success = 0; my @raw_data_pos; if( defined( $match_data ) ) { if( $DEBUG > 4 ) { warn( __PACKAGE__ . "::$sub_name, Method $sub_name has been asked to delete option '" . $match_option . "', value '" . $match_data . "'\n" ); } # Must match on both the option key and it's value if( exists( $self->{$match_option} ) ) { if( ref( $self->{$match_option} ) eq 'ARRAY' ) { if( $DEBUG > 4 ) { warn( __PACKAGE__ . "::$sub_name, Found a match on $match_option in signature\n" ); } my $__found = 0; my @good_data; foreach my $opt_value( @{$self->{$match_option}} ) { if( $opt_value->{'__value__'} eq $match_data ) { ++$__found; $success = 1; push( @raw_data_pos, $opt_value->{'__raw_data_pos__'} ); } elsif( defined( my $tt = $opt_value->{'__value__'} ) ) { push( @good_data, $opt_value ); } } if( $success ) { if( defined( $good_data[0] ) ) { # Replace the object's old data with the good data $self->{$match_option} = [ @good_data ]; } else { delete $self->{$match_option}; } } } } } elsif( exists( $self->{$match_option} ) ) { if( $DEBUG > 4 ) { warn( __PACKAGE__ . "::$sub_name, Method $sub_name has been asked to delete all data with" . " an option name of $match_option\n" ); } foreach my $opt_data( @{$self->{$match_option}} ) { push( @raw_data_pos, $opt_data->{'__raw_data_pos__'} ); } delete $self->{$match_option}; $success = 1; } if( $success ) { # cleanup the __raw_data__ storage in the object # get the last index of the __raw_data__ array foreach my $idx( @raw_data_pos ) { $self->{'__raw_data__'}->[$idx] = undef; } # Delete the } return( $success ); } sub meta { my $sub_name = 'meta'; my $self = shift || return( undef ); my $meta_name = shift || return( undef ); return( $self->option( $BRO_CONFIG->{META_DATA_PREFIX} . $meta_name ) ); } sub output { my $sub_name = 'output'; my $self = shift || return( undef ); my %args = @_; my $ret_string; my $prefix = ''; my $comments = 0; # Make a few checks on the signature to make sure it has all the # mandatory parts before outputting. $self->active(); # Check on options if( $args{sigprefix} ) { $prefix = $args{sigprefix}; } if( defined( $args{comments} ) ) { $comments = $args{comments}; } else { $comments = 1; } if( defined( $args{live} ) ) { } elsif( defined( $args{meta} ) ) { } else { # opening to a Bro signature block $ret_string = 'signature ' . $prefix . $self->{sig_id} . ' {' . "\n"; if( $comments ) { foreach my $line( @{$self->{'__raw_data__'}} ) { if( defined( $line ) ) { $ret_string = $ret_string . ' ' . $line . "\n"; } } } else { while( my( $option, $opt_array ) = each( %{$self} ) ) { if( $option ne '__raw_data__' and $option ne 'sig_id' ) { foreach my $opt_data( @{$opt_array} ) { $ret_string = $ret_string . ' ' . $option . ' ' . $opt_data->{'__value__'} . "\n"; } } } } # closing of the Bro signature block $ret_string = $ret_string . '}'; } return( $ret_string ); } sub sigid { # This is the entire Bro signature id as parsed in from a # signature block my $sub_name = 'sigid'; my $self = shift || return( undef ); if( $self->{sig_id} ) { return( $self->{sig_id} ); } else { return( undef ); } } sub active { my $sub_name = 'active'; # If passed with an argument then the new value will be set if it is valid. # If the new value is set properly then 2 is returned otherwise return -1 # If no args called then 0 returned if value is false and 1 returned if # value is true. my $self = shift || return( undef ); my $new_status; if( @_ > 0 ) { $new_status = shift; # The default is true, set it now if it doesn't already exist. if( ! defined( $self->option( 'active' ) ) ) { $self->addoption( 'active', 'true' ); } # Make sure that $new_status contains valid data if( $new_status =~ m/^(?:1|true)$/ ) { $new_status = 'true'; } elsif( $new_status =~ m/^(?:0|false)$/ ) { $new_status = 'false'; } else { return( undef ); } $self->modoption( 'active', $new_status ); return( 2 ); } if( ! defined( $self->option( 'active' ) ) or $self->option( 'active' ) eq 'true' ) { return( 1 ); } else { return( 0 ); } } sub version { my $sub_name = 'version'; my $self = shift || return( undef ); my $ver = $self->meta( 'version' ); if( defined( $ver ) and $ver =~ m/^[[:digit:]]+$/ ) { return( $ver ); } else { return( '' ); } } sub revision { my $sub_name = 'revision'; my $self = shift || return( undef ); my $rev = $self->meta( 'revision' ); if( defined( $rev ) and $rev =~ m/^[[:digit:]]+$/ ) { return( $rev ); } else { return( '' ); } } sub filelist { my $sub_name = 'filelist'; my @args = @_; # optional arguments my @file_list; my @signature_dirs; my @extra_sig_dirs; my $sigfile_suffix = $BRO_CONFIG->{BRO_SIG_SUFFIX}; # valid modes are add and override, default is add my $extra_dir_mode = 'add'; # If there are args figure out what to do with them. if( @args > 0 ) { if( $args[0] eq 'mode' ) { shift @args; $extra_dir_mode = shift @args; } push( @extra_sig_dirs, @args ); } # Verify that a valid mode was specified if( $extra_dir_mode ne 'add' and $extra_dir_mode ne 'override' ) { warn( __PACKAGE__ . "::$sub_name, Invalid method of '$extra_dir_mode' set.\n" ); return( undef ); } if( $extra_dir_mode eq 'override' ) { @signature_dirs = @extra_sig_dirs; } elsif( defined( $BRO_CONFIG->{BRO_SIG_DIR} ) or defined( $BRO_CONFIG->{BROPATH} ) ) { my $rule_path; # if/else ladder is to allow for backwards compatability and will eventually # be removed. if( defined( $BRO_CONFIG->{BRO_SIG_DIR} ) and defined( $BRO_CONFIG->{BROPATH} ) ) { $rule_path = join( ':', $BRO_CONFIG->{BRO_SIG_DIR}, $BRO_CONFIG->{BROPATH} ); } elsif( defined( $BRO_CONFIG->{BROPATH} ) ) { $rule_path = $BRO_CONFIG->{BROPATH}; } else { $rule_path = $BRO_CONFIG->{BRO_SIG_DIR}; } if( $rule_path =~ m/:/ ) { @signature_dirs = split( /:/, $rule_path ); } else { $signature_dirs[0] = $rule_path; } # If mode is add then add the additional directories into @signature_dirs if( $extra_dir_mode eq 'add' ) { push( @signature_dirs, @extra_sig_dirs ); } } foreach my $sig_dir( @signature_dirs ) { if( -d $sig_dir and -r $sig_dir and $sig_dir =~ m/^([[:print:]]+)$/ ) { # Taint clean the directory name $sig_dir = $1; if( opendir( INDIR, $sig_dir ) ) { foreach my $file_name( readdir( INDIR ) ) { if( $file_name =~ m/^([[:print:]]+$sigfile_suffix)$/ ) { # Taint clean the file name $file_name = $1; push( @file_list, join( '/', $sig_dir, $file_name ) ); } } } else { warn( __PACKAGE__ . "::$sub_name, Unable to read directory $sig_dir\n" ); next; } closedir( INDIR ); } } return( @file_list ); } sub getrules { my $sub_name = 'getrules'; # Given a Bro rule file it will return a reference to a list of # Bro::Signature objects in scalar contents and a regular list # in list context. my $rule_file = shift || return( undef ); my $sig_file_data; my @sig_blocks; my @sig_objs; if( open( INFILE, $rule_file ) ) { local $/ = undef; $sig_file_data = ; @sig_blocks = findkeyblocks( $sig_file_data ); } else { warn( "Failed to open Bro rule file at $rule_file\n" ); } close( INFILE ); # clean up some memory undef $sig_file_data; foreach my $sig_block( @sig_blocks ) { if( my $rule_obj = Bro::Signature->new( string => $sig_block ) ) { push( @sig_objs, $rule_obj ); } } if( @sig_objs > 0 ) { if( wantarray ) { return( @sig_objs ); } else { return( \@sig_objs ); } } } sub compare { my $sub_name = 'compare'; # Given two signature objects compare them and return whether they are # the same or if there is difference. # If there are no changes then this returns undef. # Valid return values for changes are: # condition - There is a difference between the conditions ( ex. http, payload, dst-ip, etc. ) # action - There is a difference in the actions ( ex. event ) # active - There is a difference in the active status ( ex. true, false ) # meta - There is a difference in the metadata ( ex. .version, .date-created, etc. ) my $first_obj = shift || return( undef ); my $second_obj = shift || return( undef ); my $meta_prefix = $BRO_CONFIG->{META_DATA_PREFIX}; $meta_prefix =~ s/\./\\./g; my $m_p = qr/^$meta_prefix.+/; # Meta prefix my %f_meta; my %f_cond; my %f_act; my %s_meta; my %s_cond; my %s_act; my %results; # If the version number is different then there is definetly an action # and/or a condition difference if( $first_obj->version() ne $second_obj->version() ) { $results{'condition'} = 1; } # Compare the active status if( $first_obj->active() ne $second_obj->active() ) { $results{'active'} = 1; } # Seperate out all of the option data from meta data for the first obj foreach my $key( keys( %{$first_obj} ) ) { if( exists( $SKIP_OPT{$key} ) ) { # Ignore the key } elsif( $key =~ $m_p ) { @{$f_meta{$key}} = $first_obj->option( $key ); } elsif( exists( $ACTIONS{$key} ) ) { @{$f_act{$key}} = $first_obj->option( $key ); } else { # the data is part of a condition which is used # by Bro to define how a signature matches. @{$f_cond{$key}} = $first_obj->option( $key ); } } # Seperate out all of the option data from meta data for the second obj foreach my $key( keys( %{$second_obj} ) ) { if( exists( $SKIP_OPT{$key} ) ) { # Ignore the key } elsif( $key =~ $m_p ) { @{$s_meta{$key}} = $second_obj->option( $key ); } elsif( exists( $ACTIONS{$key} ) ) { @{$s_act{$key}} = $second_obj->option( $key ); } else { # the data is part of a condition which is used # by Bro to define how a signature matches. @{$s_cond{$key}} = $second_obj->option( $key ); } } # Compare the conditions foreach my $key( keys( %f_cond ) ) { if( exists( $results{'condition'} ) ) { last; } if( exists( $s_cond{$key} ) ) { if( @{$f_cond{$key}} != @{$s_cond{$key}} ) { $results{'condition'} = 1; } } else { $results{'condition'} = 1; } foreach my $val( @{$f_cond{$key}} ) { if( exists( $results{'condition'} ) ) { last; } my $did_match = 0; foreach my $val2( @{$s_cond{$key}} ) { if( $val eq $val2 ) { $did_match = 1; last; } } if( ! $did_match ) { $results{'condition'} = 1; } } } foreach my $key( keys( %s_cond ) ) { if( exists( $results{'condition'} ) ) { last; } if( ! exists( $f_cond{$key} ) ) { $results{'condition'} = 1; } foreach my $val( @{$s_cond{$key}} ) { if( exists( $results{'condition'} ) ) { last; } my $did_match = 0; foreach my $val2( @{$f_cond{$key}} ) { if( $val eq $val2 ) { $did_match = 1; last; } } if( ! $did_match ) { $results{'condition'} = 1; } } } # Compare the actions foreach my $key( keys( %f_act ) ) { if( exists( $results{'action'} ) ) { last; } if( exists( $s_act{$key} ) ) { if( @{$f_act{$key}} != @{$s_act{$key}} ) { $results{'action'} = 1; } } else { $results{'action'} = 1; } foreach my $val( @{$f_act{$key}} ) { if( exists( $results{'action'} ) ) { last; } my $did_match = 0; foreach my $val2( @{$s_act{$key}} ) { if( $val eq $val2 ) { $did_match = 1; last; } } if( ! $did_match ) { $results{'action'} = 1; } } } foreach my $key( keys( %s_act ) ) { if( exists( $results{'action'} ) ) { last; } if( ! exists( $f_act{$key} ) ) { $results{'action'} = 1; } foreach my $val( @{$s_act{$key}} ) { if( exists( $results{'action'} ) ) { last; } my $did_match = 0; foreach my $val2( @{$f_act{$key}} ) { if( $val eq $val2 ) { $did_match = 1; last; } } if( ! $did_match ) { $results{'action'} = 1; } } } # If the revision numbers are differnet then there is definetly a # meta data difference if( $first_obj->revision() ne $second_obj->revision() ) { $results{'meta'} = 1; } # Compare the meta data foreach my $key( keys( %f_meta ) ) { if( exists( $results{'meta'} ) ) { last; } if( exists( $s_meta{$key} ) ) { if( @{$f_meta{$key}} != @{$s_meta{$key}} ) { $results{'meta'} = 1; } } else { $results{'meta'} = 1; } foreach my $val( @{$f_meta{$key}} ) { if( exists( $results{'meta'} ) ) { last; } my $did_match = 0; foreach my $val2( @{$s_meta{$key}} ) { if( $val eq $val2 ) { $did_match = 1; last; } } if( ! $did_match ) { $results{'meta'} = 1; } } } foreach my $key( keys( %s_meta ) ) { if( exists( $results{'meta'} ) ) { last; } if( ! exists( $f_meta{$key} ) ) { $results{'meta'} = 1; } foreach my $val( @{$s_meta{$key}} ) { if( exists( $results{'meta'} ) ) { last; } my $did_match = 0; foreach my $val2( @{$f_meta{$key}} ) { if( $val eq $val2 ) { $did_match = 1; last; } } if( ! $did_match ) { $results{'meta'} = 1; } } } if( keys( %results ) > 0 ) { return( \%results ); } else { return( 0 ); } } sub utctimenow { my $sub_name = 'utctimenow'; my @tp = gmtime(); my $ret_time = sprintf( "%4d-%02d-%02dT%02d:%02d:%02dZ", $tp[5] + 1900, $tp[4] + 1, $tp[3], $tp[2], $tp[1], $tp[0] ); return( $ret_time ); } 1; # List of reserved meta-data keywords for use by signature manipulation tools # and the number of instances which may exist in each signature. # date-created max: 1 # version-date max: 1 # revision-date max: 1 # category max: unlimited # from-file max: 1 reserved for use during editing, not used in actual signatures # version max: 1 version supplied by signature creator. # This number will be rolled if any of the # matching content changes, not meta-data. # rev max: 1 This number will be rolled if changes to # meta-data are made. No matching content # changes. #