view release on metacpan or  search on metacpan

lib/Advanced/Config/Reader.pm  view on Meta::CPAN

   # Do we have to correct for having comments in the value?
   my $cmt = convert_to_regexp_string ($rOpts->{comment}, 1);
   if ( $value =~ m/${cmt}/ ) {
      my $err = "Can't do toString() due to using comments in the value of '${tag}'\n";

      if ( $rOpts->{disable_variables} ) {
         if ( $rOpts->{disable_quotes} ) {
            die ($err, "when you've also disabled both quotes & variables!\n");
         }
         unless ( $quote_l ) {
            die ($err, "when you've disabled variables while there are quotes in the value as well!\n");
         }
      }

      # Convert the comment symbols to the special variable if no quotes are allowed.
      unless ( $quote_l ) {
         my $v = $rOpts->{variable_left} . "shft3" . $rOpts->{variable_right};
         $value =~ s/${cmt}/${v}/g;
      }
   }

   # Surround the value with quotes!
   if ( $quote_l ) {
      $value = ${quote_l} . ${value} . ${quote_r};
   }

   my $line = ${tag} . " " . $rOpts->{assign} . " " . ${value};

   DBUG_RETURN ( $line );
}


# ==============================================================

=item $string = format_encrypt_cmt ( \%rOpts )

Uses the given I<Read Options Hash> to generate a comment suitable for use
in marking a tag/value pair as ready to be encrypted.

=cut

sub format_encrypt_cmt
{
   DBUG_ENTER_FUNC ( @_ );
   my $rOpts = shift;

   DBUG_RETURN ( $rOpts->{comment} . " " . $rOpts->{encrypt_lbl} );
}


# ==============================================================

=item $status = encrypt_config_file_details ( $file, $writeFile, \%rOpts )

This function encrypts all tag values inside the specified config file that are
marked as ready for encryption and generates a new config file with everything
encrypted.  If a tag/value pair isn't marked as ready for encryption it is left
alone.  By default this label is B<ENCRYPT>.

After a tag's value has been encrypted, the label in the comment is updated
from B<ENCRYPT> to B<DECRYPT> in the new file.

If you are adding new B<ENCRYPT> tags to an existing config file that already
has B<DECRYPT> tags in it, you must use the same encryption related options in
I<%rOpts> as the last time.  Otherwise you won't be able to decrypt all
encrypted values.

This method ignores any request to source in other config files.  You must
encrypt each file individually.

It writes the results of the encryption process to I<$writeFile>.

See L<Advanced::Config::Options> for some caveats about this process.

Returns:  B<1> if something was encrypted.  B<-1> if nothing was encrypted.
Otherwise B<0> on error.

=cut

sub encrypt_config_file_details
{
   DBUG_ENTER_FUNC ( @_ );
   my $file    = shift;
   my $scratch = shift;
   my $rOpts   = shift;

   unlink ( $scratch );

   # The labels to search for ...
   my $decrypt_str = convert_to_regexp_string ($rOpts->{decrypt_lbl});
   my $encrypt_str = convert_to_regexp_string ($rOpts->{encrypt_lbl});
   my $hide_str    = convert_to_regexp_string ($rOpts->{hide_lbl});

   my $assign_str  = convert_to_regexp_string ($rOpts->{assign});
   my ($lb, $rb) = ( convert_to_regexp_string ($rOpts->{section_left}),
                     convert_to_regexp_string ($rOpts->{section_right}) );

   # The label separators used when searching for option labels in a comment ...
   my $lbl_sep = '[\s.,$!-()]';

   my $mask = "*"x8;

   DBUG_PRINT ("INFO", "Opening for reading the config file named: %s", $file);

   unless ( open (ENCRYPT, "<", $file) ) {
      return DBUG_RETURN ( croak_helper ($rOpts,
                                         "Unable to open the config file.", 0) );
   }

   DBUG_PRINT ("INFO", "Creating scratch file named: %s", $scratch);
   unless ( open (NEW, ">", $scratch) ) {
      close (ENCRYPT);
      return DBUG_RETURN ( croak_helper ($rOpts,
                                "Unable to create the scratch config file.", 0) );
   }

   # Misuse of this option makes the config file unreadable ...
   if ( $rOpts->{use_utf8} ) {
      binmode (ENCRYPT, "encoding(UTF-8)");
      binmode (NEW,     "encoding(UTF-8)");

lib/Advanced/Config/Reader.pm  view on Meta::CPAN

         unless (print NEW $line, "\n") {
            return DBUG_RETURN ( croak_helper ($rOpts, $errMsg, 0) );
         }
         next;
      }

      # --------------------------------------------
      # Now let's encrypt the Tag/Value pair ...
      # --------------------------------------------

      ++$count;

      # Save the values we need to change safe to use as RegExp strings.
      my $old_cmt   = convert_to_regexp_string ( $cmt, 1 );
      my $old_value = convert_to_regexp_string ( $value, 1 );

      # Modify the label in the comment ...
      my $lbl = $rOpts->{decrypt_lbl};
      $cmt =~ s/(^|${lbl_sep})${encrypt_str}(${lbl_sep}|$)/$1${lbl}$2/g;

      # Remove any balanced quotes from arround the value ...
      if ( $lq ) {
         $value =~ s/^${lq}//;
         $value =~ s/${rq}$//;
      }

      my ($new_value, $nlq, $nrq);
      $new_value = encrypt_value ( $value, $t2, $rOpts, $file);
      ($new_value, $nlq, $nrq) = _apply_escape_sequences ( $new_value, $rOpts );

      if ( is_assign_spaces ( $rOpts ) ) {
         $line =~ s/^(\s*\S+\s+)${old_value}/$1${nlq}${new_value}${nrq}/;
      } else {
         $line =~ s/(\s*${assign_str}\s*)${old_value}/$1${nlq}${new_value}${nrq}/;
      }
      $line =~ s/${old_cmt}$/${cmt}/;

      unless (print NEW $line, "\n") {
         return DBUG_RETURN ( croak_helper ($rOpts, $errMsg, 0) );
      }
   }  # End the while ENCRYPT loop ...

   close (ENCRYPT);
   close (NEW);

   my $status = ($count == 0) ? -1 : 1;

   DBUG_RETURN ( $status );
}


# ==============================================================

=item $status = decrypt_config_file_details ( $file, $writeFile, \%rOpts )

This function decrypts all tag values inside the specified config file that are
marked as encrypted and generates a new file with everything decrypted.  If a
tag/value pair isn't marked as being encrypted it is left alone.  By default
this label is B<DECRYPT>.

After a tag's value has been decrypted, the label in the comment is updated
from B<DECRYPT> to B<ENCRYPT> in the config file.

For this to work, the encryption related options in I<\%rOpts> must match what
was used in the call to I<encrypt_config_file_details> or the decryption will
fail.

This method ignores any request to source in other config files.  You must
decrypt each file individually.

It writes the results of the decryption process to I<$writeFile>.

See L<Advanced::Config::Options> for some caveats about this process.

Returns:  B<1> if something was decrypted.  B<-1> if nothing was decrypted.
Otherwise B<0> on error.

=cut

sub decrypt_config_file_details
{
   DBUG_ENTER_FUNC ( @_ );
   my $file    = shift;
   my $scratch = shift;
   my $rOpts   = shift;

   unlink ( $scratch );

   # The labels to search for ...
   my $decrypt_str = convert_to_regexp_string ($rOpts->{decrypt_lbl});
   my $encrypt_str = convert_to_regexp_string ($rOpts->{encrypt_lbl});
   my $hide_str    = convert_to_regexp_string ($rOpts->{hide_lbl});

   # The label separators used when searching for option labels in a comment ...
   my $lbl_sep = '[\s.,$!-()]';

   my $assign_str  = convert_to_regexp_string ($rOpts->{assign});
   my ($lb, $rb) = ( convert_to_regexp_string ($rOpts->{section_left}),
                     convert_to_regexp_string ($rOpts->{section_right}) );

   my $mask = "*"x8;

   DBUG_PRINT ("INFO", "Opening for reading the config file named: %s", $file);

   unless ( open (DECRYPT, "<", $file) ) {
      return DBUG_RETURN ( croak_helper ($rOpts,
                                         "Unable to open the config file.", 0) );
   }

   DBUG_PRINT ("INFO", "Creating scratch file named: %s", $scratch);
   unless ( open (NEW, ">", $scratch) ) {
      close (DECRYPT);
      return DBUG_RETURN ( croak_helper ($rOpts,
                                "Unable to create the scratch config file.", 0) );
   }

   # Misuse of this option makes the config file unreadable ...
   if ( $rOpts->{use_utf8} ) {
      binmode (DECRYPT, "encoding(UTF-8)");
      binmode (NEW,     "encoding(UTF-8)");
   }