PBC.pm

package Crypt::PBC::Element;

use strict;
use Carp;
use MIME::Base64;
use Math::BigInt lib => 'GMP';

our %tt; # This maps our element types and our pairings.  Arguably this should be
         # done in the element references themselves, but those are scalar refs, not
         # hash refs.

use overload 
    '""'       => sub { my $this = shift; "Crypt::PBC::Element-$tt{$$this}{t}#$$this" },
    'nomethod' => sub { my $this = shift; my $that = pop; croak "arithmetic operation '$that' not defined for $this" };

1;

# DESTROY {{{
sub DESTROY {
    my $this = shift;

    my $i = $$this;

    &Crypt::PBC::element_clear( $this );
    
    delete $tt{$i};
}
# }}}
# clone {{{
sub clone {
    my $this = shift;
    my ($type, $pair) = @{ $tt{$$this} }{qw(t p)};

    my $that = eval "\$pair->init_$type";
    if( $@ ) {
        # Can't call method "init_G1" on an undefined value at (eval 2) line 1.
        # at t/13_pow_arith.t line 28
        chomp $@; $@ =~ s/at \(eval \d+\) line \d+/during Crypt::PBC::Element::clone()/;
        croak $@;
    }

    return $that->set( $this );
}
*copy = *clone;
# }}}

#### exporters
# as_bytes {{{
sub as_bytes {
    my $this = shift;
    
    return &Crypt::PBC::export_element( $this );
}
# }}}
# as_hex {{{
sub as_hex {
    my $this = shift;
    
    return unpack("H*", $this->as_bytes);
}
*as_str = *as_hex;
# }}}
# as_base64 {{{
sub as_base64 {
    my $this = shift;
    my $arg  = shift || "";
    
    my $that = encode_base64($this->as_bytes, $arg);
    $that =~ s/\n$//sg;

    return $that;
}
# }}}
# as_bigint {{{
sub as_bigint {
    my $this = shift;
    my $that = &Crypt::PBC::element_to_mpz($this);

    my $int = new Math::BigInt;
       $int->{value} = $that;
       $int->{sign}  = '+';

     # I wanted to do something like thits, but I think
     # the mpz_t's returned from element_to_mpz are always going to be positive...
     # $int->{sign}  = $this->is_neg ? "-" : "+"; 

    return $int;
}
# }}}
# stddump {{{
sub stddump {
    my $this = shift;
    
    &Crypt::PBC::element_fprintf(*STDOUT, '%B', $this );
}
# }}}
# errdump {{{
sub errdump {
    my $this = shift;
    
    return &Crypt::PBC::element_fprintf(*STDERR, '%B', $this );
}
# }}}

#### initializers and set routines
# random {{{
sub random {
    my $this = shift;
    
    &Crypt::PBC::element_random( $this );

    return $this;
}
# }}}
# set_to_bytes {{{
sub set_to_bytes {
    my $this = shift;
    my $data = shift;

    croak "provide something to set the element to" unless defined $data and length $data > 0;
    &Crypt::PBC::element_from_bytes($this, $data);

    $this;
}
# }}}
# set_to_hash {{{
sub set_to_hash {
    my $this = shift;
    my $hash = shift;

    croak "provide something to set the element to" unless defined $hash and length $hash > 0;
    my $type = $tt{$$this}{t};
  # warn " >type=$type; hash=$hash...@_...<\n"; 
    &Crypt::PBC::element_from_hash($this, $hash);
  # warn " <type=$type; hash=$hash...@_...>\n"; 

    $this;
}
# }}}
# set_to_int {{{
sub set_to_int {
    my $this = shift;
    my $int  = shift;

    croak "int provided ($int) is not acceptable" unless $int =~ m/^\-?[0-9]+\z/s;

    &Crypt::PBC::element_set_si($this, $int);

    $this;
}
# }}}
# set_to_bigint {{{
sub set_to_bigint {
    my $this = shift;
    my $int  = shift;

    croak "int provided is not a bigint" unless ref $int and $int->isa("Math::BigInt");

    &Crypt::PBC::element_set_mpz($this, $int->{value});

    $this;
}
# }}}
# set {{{
sub set {
    my $this = shift;
    my $that = shift;

    croak "LHS and RHS must be algebraically similar" unless $tt{$$this}{c} eq $tt{$$that}{c};

    &Crypt::PBC::element_set($this, $that);

    $this;
}
# }}}
# set0 {{{
sub set0 {
    my $this = shift;
    my $that = shift;

    &Crypt::PBC::element_set0($this);

    $this;
}
# }}}
# set1 {{{
sub set1 {
    my $this = shift;
    my $that = shift;

    &Crypt::PBC::element_set1($this);

    $this;
}
# }}}

#### comparisons
# is0 {{{
sub is0 {
    my $this = shift;

    return &Crypt::PBC::element_is0( $this ); # returns 0 if they're algebraically similar
}
# }}}
# is1 {{{
sub is1 {
    my $this = shift;

    return &Crypt::PBC::element_is1( $this );
}
# }}}
# is_eq {{{
sub is_eq {
    my $this = shift;
    my $that = shift;

    croak "LHS and RHS should both have types" unless exists $tt{$$this} and $tt{$$this}{c} eq $tt{$$that}{c};

    return not &Crypt::PBC::element_cmp( $this, $that ); # returns 0 if they're algebraically similar
}
# }}}
# is_sqr {{{
sub is_sqr {
    my $this = shift;

    croak "LHS should have a type" unless exists $tt{$$this};
    my $type = $tt{$$this}{t};

    return 1 if $type eq "G1";
    return 1 if $type eq "G2";
    return 1 if $type eq "GT";

    return &Crypt::PBC::element_is_sqr( $this );
}
# }}}

#### exponentiation
# pow_zn {{{
sub pow_zn {
    my $this = shift;
    my $base = shift;
    my $expo = shift;

    if( defined $base and not defined $expo ) {
        $expo = $base;
        $base = $this;
    }

    croak "LHS and BASE must be algebraically similar" unless exists $tt{$$this} and $tt{$$this}{c} eq $tt{$$base}{c};
    croak "EXPO must be of type Zr"                    unless $tt{$$expo}{t} eq "Zr";

    &Crypt::PBC::element_pow_zn( $this, $base, $expo );

    $this;
}
# }}}
# pow2_zn {{{
sub pow2_zn {
    my $this = shift;
    my $a1 = shift;
    my $n1 = shift;
    my $a2 = shift;
    my $n2 = shift;

    croak "LHS and a1 must be algebraically similar" unless exists $tt{$$this} and $tt{$$this}{c} eq $tt{$$a1}{c};
    croak "LHS and a2 must be algebraically similar" unless $tt{$$this}{c} eq $tt{$$a2}{c};
    croak "n1 must be of type Zr"                unless $tt{$$n1}{t} eq "Zr";
    croak "n2 must be of type Zr"                unless $tt{$$n2}{t} eq "Zr";

    &Crypt::PBC::element_pow2_zn( $this, $a1, $n1, $a2, $n2 );

    $this;
}
# }}}
# pow3_zn {{{
sub pow3_zn {
    my $this = shift;
    my $a1 = shift;
    my $n1 = shift;
    my $a2 = shift;
    my $n2 = shift;
    my $a3 = shift;
    my $n3 = shift;

    croak "LHS and a1 must be algebraically similar" unless exists $tt{$$this} and $tt{$$this}{c} eq $tt{$$a1}{c};
    croak "LHS and a2 must be algebraically similar" unless $tt{$$this}{c} eq $tt{$$a2}{c};
    croak "LHS and a3 must be algebraically similar" unless $tt{$$this}{c} eq $tt{$$a3}{c};
    croak "n1 must be of type Zr"                unless $tt{$$n1}{t} eq "Zr";
    croak "n2 must be of type Zr"                unless $tt{$$n2}{t} eq "Zr";
    croak "n3 must be of type Zr"                unless $tt{$$n3}{t} eq "Zr";

    &Crypt::PBC::element_pow3_zn( $this, $a1, $n1, $a2, $n2, $a3, $n3 );

    $this;
}
# }}}

# pow_bigint {{{
sub pow_bigint {
    my $this = shift;
    my $base = shift;
    my $expo = shift;

    if( defined $base and not defined $expo ) {
        $expo = $base;
        $base = $this;
    }

    croak "EXPO provided is not a bigint" unless ref $expo and $expo->isa("Math::BigInt");
    croak "LHS and BASE must be algebraically similar" unless exists $tt{$$this} and $tt{$$this}{c} eq $tt{$$base}{c};

    &Crypt::PBC::element_pow_mpz( $this, $base, $expo->{value} );

    $this;
}
# }}}
# pow2_bigint {{{
sub pow2_bigint {
    my $this = shift;
    my $a1 = shift;
    my $n1 = shift;
    my $a2 = shift;
    my $n2 = shift;

    croak "n1 provided is not a bigint" unless ref $n1 and $n1->isa("Math::BigInt");
    croak "n2 provided is not a bigint" unless ref $n2 and $n2->isa("Math::BigInt");
    croak "LHS and a1 must be algebraically similar" unless exists $tt{$$this} and $tt{$$this}{c} eq $tt{$$a1}{c};
    croak "LHS and a2 must be algebraically similar" unless $tt{$$this}{c} eq $tt{$$a2}{c};

    &Crypt::PBC::element_pow2_mpz( $this, $a1, $n1->{value}, $a2, $n2->{value} );

    $this;
}
# }}}
# pow3_bigint {{{
sub pow3_bigint {
    my $this = shift;
    my $a1 = shift;
    my $n1 = shift;
    my $a2 = shift;
    my $n2 = shift;
    my $a3 = shift;
    my $n3 = shift;

    croak "n1 provided is not a bigint" unless ref $n1 and $n1->isa("Math::BigInt");
    croak "n2 provided is not a bigint" unless ref $n2 and $n2->isa("Math::BigInt");
    croak "n3 provided is not a bigint" unless ref $n3 and $n2->isa("Math::BigInt");

    croak "LHS and a1 must be algebraically similar" unless exists $tt{$$this} and $tt{$$this}{c} eq $tt{$$a1}{c};
    croak "LHS and a2 must be algebraically similar" unless $tt{$$this}{c} eq $tt{$$a2}{c};
    croak "LHS and a3 must be algebraically similar" unless $tt{$$this}{c} eq $tt{$$a3}{c};

    &Crypt::PBC::element_pow3_mpz( $this, $a1, $n1->{value}, $a2, $n2->{value}, $a3, $n3->{value} );

    $this;
}
# }}}

#### arith
## 1op
# square {{{
sub square {
    my $lhs  = shift;
    my $rhs  = shift;

    if( $rhs ) {
        croak "LHS and RHS must be algebraically similar" unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs}{c};

    } else {
        $rhs = $lhs;
    }

    &Crypt::PBC::element_square( $lhs, $rhs );

    $lhs;
}
# }}}
# double {{{
sub double {
    my $lhs  = shift;
    my $rhs  = shift;

    if( $rhs ) {
        croak "LHS and RHS must be algebraically similar" unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs}{c};

    } else {
        $rhs = $lhs;
    }

    &Crypt::PBC::element_double( $lhs, $rhs );

    $lhs;
}
# }}}
# halve {{{
sub halve {
    my $lhs  = shift;
    my $rhs  = shift;

    if( $rhs ) {
        croak "LHS and RHS must be algebraically similar" unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs}{c};

    } else {
        $rhs = $lhs;
    }

    &Crypt::PBC::element_halve( $lhs, $rhs );

    $lhs;
}
# }}}
# neg {{{
sub neg {
    my $lhs  = shift;
    my $rhs  = shift;

    if( $rhs ) {
        croak "LHS and RHS must be algebraically similar" unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs}{c};

    } else {
        $rhs = $lhs;
    }

    &Crypt::PBC::element_neg( $lhs, $rhs );

    $lhs;
}
# }}}
# invert {{{
sub invert {
    my $lhs  = shift;
    my $rhs  = shift;

    if( $rhs ) {
        croak "LHS and RHS must be algebraically similar" unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs}{c};

    } else {
        $rhs = $lhs;
    }

    &Crypt::PBC::element_invert( $lhs, $rhs );

    $lhs;
}
# }}}

## 2op
# add {{{
sub add {
    my $lhs  = shift;
    my $rhs1 = shift;
    my $rhs2 = shift;

    if( $rhs2 ) {
        croak "LHS, RHS1 and RHS2 must be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs1}{c} and $tt{$$rhs1}{c} eq $tt{$$rhs2}{c};

        &Crypt::PBC::element_add( $lhs, $rhs1, $rhs2 );

    } else {
        croak "LHS and RHS should be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs1}{c};

        &Crypt::PBC::element_add( $lhs, $lhs, $rhs1 );
    }

    $lhs;
}
# }}}
# Sub {{{
sub Sub {
    my $lhs  = shift;
    my $rhs1 = shift;
    my $rhs2 = shift;

    if( $rhs2 ) {
        croak "LHS, RHS1 and RHS2 must be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs1}{c} and $tt{$$rhs1}{c} eq $tt{$$rhs2}{c};

        &Crypt::PBC::element_sub( $lhs, $rhs1, $rhs2 );

    } else {
        croak "LHS and RHS should be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs1}{c};

        &Crypt::PBC::element_sub( $lhs, $lhs, $rhs1 );
    }

    $lhs;
}
# }}}
# mul {{{
sub mul {
    my $lhs  = shift;
    my $rhs1 = shift;
    my $rhs2 = shift;

    if( $rhs2 ) {
        croak "LHS, RHS1 and RHS2 must be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs1}{c} and $tt{$$rhs1}{c} eq $tt{$$rhs2}{c};

        &Crypt::PBC::element_mul( $lhs, $rhs1, $rhs2 );

    } else {
        croak "LHS and RHS should be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs1}{c};

        &Crypt::PBC::element_mul( $lhs, $lhs, $rhs1 );
    }

    $lhs;
}
# }}}
# div {{{
sub div {
    my $lhs  = shift;
    my $rhs1 = shift;
    my $rhs2 = shift;

    if( $rhs2 ) {
        croak "LHS, RHS1 and RHS2 must be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs1}{c} and $tt{$$rhs1}{c} eq $tt{$$rhs2}{c};

        &Crypt::PBC::element_div( $lhs, $rhs1, $rhs2 );

    } else {
        croak "LHS and RHS should be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs1}{c};

        &Crypt::PBC::element_div( $lhs, $lhs, $rhs1 );
    }

    $lhs;
}
# }}}

# mul_zn {{{
sub mul_zn {
    my $lhs  = shift;
    my $rhs1 = shift;
    my $rhs2 = shift;

    if( $rhs2 ) {
        croak "LHS, RHS1 must be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs1}{c} and $tt{$$rhs2}{t} eq "Zr";

        &Crypt::PBC::element_mul_zn( $lhs, $rhs1, $rhs2 );

    } else {
        croak "RHS should be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$rhs1}{t} eq "Zr";

        &Crypt::PBC::element_mul_zn( $lhs, $lhs, $rhs1 );
    }

    $lhs;
}
# }}}
# mul_int {{{
sub mul_int {
    my $lhs  = shift;
    my $rhs1 = shift;
    my $rhs2 = shift;

    if( $rhs2 ) {
        croak "LHS, RHS1 must be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs1}{c};
        croak "int provided ($rhs2) is not acceptable" unless $rhs2 =~ m/^\-?[0-9]+\z/s;

        &Crypt::PBC::element_mul_si( $lhs, $rhs1, $rhs2 );

    } else {
        croak "int provided ($rhs1) is not acceptable" unless $rhs1 =~ m/^\-?[0-9]+\z/s;

        &Crypt::PBC::element_mul_si( $lhs, $lhs, $rhs1 );
    }

    $lhs;
}
# }}}
# mul_bigint {{{
sub mul_bigint {
    my $lhs  = shift;
    my $rhs1 = shift;
    my $rhs2 = shift;

    if( $rhs2 ) {
        croak "LHS, RHS1 must be algebraically similar" 
        unless exists $tt{$$lhs} and $tt{$$lhs}{c} eq $tt{$$rhs1}{c};
        croak "int provided is not a bigint" unless ref $rhs2 and $rhs2->isa("Math::BigInt");

        &Crypt::PBC::element_mul_si( $lhs, $rhs1, $rhs2 );

    } else {
        croak "int provided is not a bigint" unless ref $rhs1 and $rhs1->isa("Math::BigInt");

        &Crypt::PBC::element_mul_si( $lhs, $lhs, $rhs1 );
    }

    $lhs;
}
# }}}

# pairing_apply {{{
sub pairing_apply {
    my $this = shift;
    my $rhs1 = shift;
    my $rhs2 = shift;
    my $pair = $tt{$$this}{p};

    my $c1 = $tt{$$rhs1}{c};
    my $c2 = $tt{$$rhs2}{c};

    croak "group type for LHS must be GT"  unless $tt{$$this}{t} eq "GT";
    croak "group type for RHS1 must be G1" unless $c1 eq "G1" or $c1 eq "G[12]";
    croak "group type for RHS2 must be G2" unless $c2 eq "G2" or $c2 eq "G[12]";

    &Crypt::PBC::pairing_apply( $this => ($rhs1, $rhs2) => $pair );

    $this;
}
*ehat          = *pairing_apply;
*e_hat         = *pairing_apply;
*apply_pairing = *pairing_apply;
# }}}

#### package Crypt::PBC::Pairing {{{

package Crypt::PBC::Pairing;

use strict;
use Carp;

1;

sub _stype {
    my $this = shift;
    my $that = shift;
    my $type = shift;

    $Crypt::PBC::Element::tt{$$that} = {
        t => $type,
        p => $this,
        c => $type,
    };

    if( $type =~ m/G[12]/ and &Crypt::PBC::pairing_is_symmetric($this) ) {
        $Crypt::PBC::Element::tt{$$that}{c} = "G[12]";
    }

    return;
}

sub init_G1 { my $this = shift; my $that = &Crypt::PBC::element_init_G1( $this ); $this->_stype($that => "G1"); $that }
sub init_G2 { my $this = shift; my $that = &Crypt::PBC::element_init_G2( $this ); $this->_stype($that => "G2"); $that }
sub init_GT { my $this = shift; my $that = &Crypt::PBC::element_init_GT( $this ); $this->_stype($that => "GT"); $that }
sub init_Zr { my $this = shift; my $that = &Crypt::PBC::element_init_Zr( $this ); $this->_stype($that => "Zr"); $that }
sub DESTROY { my $this = shift; my $that = &Crypt::PBC::pairing_clear(   $this ); }

# }}}
#### package Crypt::PBC {{{

package Crypt::PBC;

use strict;
use warnings;
use Carp;
use base 'Exporter';

our %EXPORT_TAGS = ( 'all' => [ qw( ) ] ); 
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw( );
our $VERSION = 0.855;

sub AUTOLOAD {
    my $constname;
    our $AUTOLOAD; ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "&Crypt::PBC::constant not defined" if $constname eq 'constant';
    my ($error, $val) = constant($constname);
    if( $error ) { croak $error }
    goto &$AUTOLOAD;
}

require XSLoader;
XSLoader::load('Crypt::PBC', $VERSION);

1;

sub new {
    my $class = shift;
    my $that;
    my $arg = shift; 

    if( ref($arg) eq "GLOB" ) {
        $that = &Crypt::PBC::pairing_init_stream($arg);

    } elsif( $arg !~ m/\n/ and -f $arg ) {

        open my $in, $arg or croak "couldn't open param file ($arg): $!";
        $that = &Crypt::PBC::pairing_init_stream($in);
        close $in;

    } elsif( $arg ) {
        $arg =~ s/^\s*//s;
        $arg =~ s/\s*$//s;

        if( $arg =~ m/^(?s:type\s+[a-z]+\s*|[a-z0-9]+\s+[0-9]+\s*)+\z/s ) {
            $that = &Crypt::PBC::pairing_init_str($arg);

        } else {
            croak "either the filename doesn't exist or that param string is unparsable: $arg";
        }

    } else {
        croak "you must pass a file, glob (stream), or init params to new()";
    }

    croak "something went wrong ... you must pass a file, glob (stream), or init params to new()" unless $$that>0;
    return $that;
}

# }}}

1;