File Coverage

blib/lib/Crypt/Cisco.pm

Criterion	Covered	Total	%
statement	51	62	82.2
branch	16	22	72.7
condition	2	6	33.3
subroutine	6	8	75.0
pod	4	4	100.0
total	79	102	77.4

package Crypt::Cisco;

##################################################
# AUTHOR = Michael Vincent
# www.VinsWorld.com
##################################################

use strict;
use warnings;
use Carp;

our $VERSION = '1.00';

use Exporter;
our %EXPORT_TAGS = ( 'subs' => [qw( cisco_encrypt cisco_decrypt )], );
our @EXPORT_OK = ( @{$EXPORT_TAGS{'subs'}} );

our @ISA = qw(Exporter);

# Cisco's XOR key
my @xlat = (
    0x64, 0x73, 0x66, 0x64, 0x3B, 0x6B, 0x66, 0x6F, 0x41, 0x2C, 0x2E, 0x69,
    0x79, 0x65, 0x77, 0x72, 0x6B, 0x6C, 0x64, 0x4A, 0x4B, 0x44, 0x48, 0x53,
    0x55, 0x42, 0x73, 0x67, 0x76, 0x63, 0x61, 0x36, 0x39, 0x38, 0x33, 0x34,
    0x6E, 0x63, 0x78, 0x76, 0x39, 0x38, 0x37, 0x33, 0x32, 0x35, 0x34, 0x6B,
    0x3B, 0x66, 0x67, 0x38, 0x37
);

my $warn = sprintf
    "\n" .
    "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n" .
    "'password_*' subs are deprecated.\n" .
    "They will be removed from a future release." .
    "Instead, use 'cisco_*'\n" .
    "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n" .
    "\n";

##################################################
# Start Public Module
##################################################

sub password_decrypt {
    warn($warn);
    return cisco_decrypt(@_);
}

sub cisco_decrypt {
    my $self = shift;

    my $passwd;

    # Call as sub
    if ( $self =~ /^Crypt::Cisco/ ) {
        ($passwd) = @_;
    } else {
        $passwd = $self;
    }

    if ( ( $passwd =~ /^[\da-f]+$/i ) and ( length($passwd) > 2 ) ) {
        if ( !( length($passwd) & 1 ) ) {
            my $dec = "";
            my ( $s, $e ) = ( $passwd =~ /^(..)(.+)/o );

            for ( my $i = 0; $i < length($e); $i += 2 ) {

                # If we move past the end of the XOR key, reset
                if ( $s > $#xlat ) { $s = 0 }
                $dec .= sprintf "%c",
                  hex( substr( $e, $i, 2 ) ) ^ $xlat[$s++];
            }
            return $dec;
        }
    }
    carp("Invalid password `$passwd'");
    return "";
}

sub password_encrypt {
    warn($warn);
    return cisco_decrypt(@_);
}

sub cisco_encrypt {
    my $self = shift;

    my ( $cleartxt, $index );

    # Call as sub
    if ( $self =~ /^Crypt::Cisco/ ) {
        ( $cleartxt, $index ) = @_;
    } else {
        $cleartxt = $self;
        ($index) = @_;
    }

    my $start = 0;
    my $end   = $#xlat;

    if ( defined $index ) {
        if ( $index =~ /^\d+$/ ) {
            if ( ( $index < 0 ) or ( $index > $end ) ) {
                carp("Index out of range 0-$#xlat: $index");
                return "";
            } else {
                $start = $end = $index;
            }
        }
    } else {
        $start = $end = int( rand( $#xlat + 1 ) );
    }

    my @passwds;
    for ( my $j = $start; $j <= $end; $j++ ) {
        my $encrypt = sprintf "%02i", $j;
        my $s = $j;

        for ( my $i = 0; $i < length($cleartxt); $i++ ) {

            # If we move past the end of the XOR key, reset
            if ( $s > $#xlat ) { $s = 0 }
            $encrypt .= sprintf "%02X",
              ord( substr( $cleartxt, $i, 1 ) ) ^ $xlat[$s++];
        }
        push @passwds, $encrypt;
    }

    my $ret = \@passwds;
    if ( $#passwds == 0 ) {
        $ret = $passwds[0];
    }

    if ( wantarray ) {
        return @passwds;
    } else {
        return $ret;
    }
}

##################################################
# End Public Module
##################################################

1;

__END__