User Tools

Site Tools


en-234-api-perl


API for Perl Applications


package fzup_#idchannel#;

# ========================================================================================
#
#   FOLLOWZUP PROJECT
#
# ========================================================================================
#
#   Copyright (C) 2016 Followzup.com
#
#   This program is free software: you can redistribute it and/or modify it under
#   the terms of the GNU General Public License as published by the Free Software
#   Foundation, either version 3 of the License, or any later version.
#
#   This program is distributed in the hope that it will be useful, but WITHOUT 
#   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 
#   FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program.  If not, see <http://www.gnu.org/licenses/>
#
# ========================================================================================

##
# Contributor: Gianluca Mario Ghisleni
# E-mail:      gianlucamario at gmail.com
##

use strict;
use warnings;
use MIME::Base64;
use Crypt::OpenSSL::RSA;
use Crypt::OpenSSL::Random;
use Crypt::Mode::CBC;
use Crypt::Cipher::AES;
use LWP::UserAgent;
use XML::Simple;
#use utf8;

# Constructor
sub new {
  my $class = shift;
  my $self  = {
    _fzup_channel  => "#idchannel#",
    _fzup_lastseq  => 0,
    _fzup_pubkey   => "",
    _fzup_pubkey64 => "#pubkey64#",
    _refPubKey     => "",
  };

  $self->{ _fzup_pubkey } = decode_base64( $self->{ _fzup_pubkey64 } );
  $self->{ _refPubKey }   = Crypt::OpenSSL::RSA->new_public_key( $self->{ _fzup_pubkey } );
  $self->{ _refPubKey }->use_pkcs1_padding();

  bless( $self, $class );
  return ( $self );
} ## end sub new

# Decrypt user message from mobile app
sub decrypt {
  my $self           = shift;
  my $fzup_encrypt64 = shift;

  # Decode from base64
  my $fzup_encrypt = decode_base64( $fzup_encrypt64 );

  # Decrypt with public key RSA
  my $fzup_decrypt = $self->{ _refPubKey }->public_decrypt( $fzup_encrypt );

  return $fzup_decrypt;
} ## end sub decrypt


sub submit {
  my $self       = shift;
  my @fzup_tab   = @_;
  my ($fzup_xml, $fzup_frame1, $fzup_frame2, $fzup_frame3, $fzup_key1, $fzup_key2, $fzup_key3, $fzup_retcode, $fzup_retFrame3);
  my %fzup_param = (
    "FZUP_COMMAND"  => "",
    "FZUP_LASTSEQ"  => 0,
    "FZUP_USER"     => "",
    "FZUP_SUBSCODE" => "",
    "FZUP_HOURS"    => 0,
    "FZUP_MSGTEXT"  => "",
    "FZUP_MSGURL"   => "",
  );

  foreach ( @fzup_tab ) {
    my ( $param, $val ) = split( /=/, $_, 2 );
    $param =~ s/^\s+|\s+$//g;
    $val =~ s/^\s+|\s+$//g;
    $fzup_param{ $param } = $val if ( exists $fzup_param{ $param } );
  } ## end for ( $i = 0; $i < count...)

  # convert message and URL to base64
  $fzup_param{ "FZUP_MSGTEXT" } = encode_base64( $fzup_param{ "FZUP_MSGTEXT" }, '' );
  $fzup_param{ "FZUP_MSGURL" }  = encode_base64( $fzup_param{ "FZUP_MSGURL" }, '' );

  # build request
  if ( $fzup_param{ "FZUP_COMMAND" } eq "chck" ) {
    $fzup_xml = sprintf( 
      "<usr>%s</usr><sub>%s</sub>", 
      $fzup_param{ "FZUP_USER" }, 
      $fzup_param{ "FZUP_SUBSCODE" } 
    );
  } elsif ( $fzup_param{ "FZUP_COMMAND" } eq "smsg" ) {
    $fzup_xml = sprintf( 
      "<usr>%s</usr><hrs>%s</hrs><msg>%s</msg><url>%s</url>", 
      $fzup_param{ "FZUP_USER" }, 
      $fzup_param{ "FZUP_HOURS" }, 
      $fzup_param{ "FZUP_MSGTEXT" },  
      $fzup_param{ "FZUP_MSGURL" } 
    );
  }else{
    return [ "6103", $self->{_fzup_lastseq}, qq(<?xml version="1.0" encoding="utf-8"?><followzup></followzup>)];
  }

  $self->{_fzup_lastseq} = $fzup_param{"FZUP_LASTSEQ"} if($fzup_param{"FZUP_LASTSEQ"} && $fzup_param{"FZUP_LASTSEQ"} =~ /^\d+$/  );

  do{
    # set next sequence and build frame request (xml)
    $self->{_fzup_lastseq}++;
    $fzup_frame1  = qq(<?xml version="1.0" encoding="utf-8"?><followzup>);
    $fzup_frame1 .= sprintf(
      "<com>%s</com><seq>%s</seq>%s</followzup>",
      $fzup_param{"FZUP_COMMAND"},
      $self->{_fzup_lastseq},
      $fzup_xml
    );
    # padding xml text with spaces to 16 bytes block
    $fzup_frame1 .= " " x ((16 - length($fzup_frame1)) % 16);

    # generate random AES key
    $fzup_key1 = Crypt::OpenSSL::Random::random_pseudo_bytes(24);
   
    #  Encrypt xml text with AES key
    my $cbc = Crypt::Mode::CBC->new('AES', 16);
    $fzup_frame2 = $cbc->encrypt($fzup_frame1, $fzup_key1, chr(0) x 16);
    $fzup_frame3 = encode_base64($fzup_frame2, '');

    # encrypt AES key with RSA PublicKey
    $fzup_key2 = $self->{ _refPubKey }->encrypt( $fzup_key1 );
    $fzup_key3 = encode_base64($fzup_key2, '');

    # build http post request
    my $ua = LWP::UserAgent->new(agent => "wschannel: " . $self->{_fzup_channel}); 
    my $form = {
      "id" => $self->{_fzup_channel}, 
      "key" => $fzup_key3, 
      "frame" => $fzup_frame3
    };
    my $res = $ua->post( 
      #"http://conlaos.com.br/perl/api/phpListParamPost.php",
      "http://www.followzup.com/wschannel", 
      'Content_Type' => 'multipart/form-data',
      'Content' => {
        "id" => $self->{_fzup_channel}, 
        "key" => $fzup_key3, 
        "frame" => $fzup_frame3
      }

    );
   
    # extract response tag        
    my $xml = XML::Simple->new();
    my $xmlHash = $xml->XMLin($res->content);
   
    # extract RETCODE 
    $fzup_retcode = $xmlHash->{'retcode'};

    # extract and decrypt RETFRAME with AES key 
    my $fzup_retFrame1 = $xmlHash->{'retframe'};
    my $fzup_retFrame2 = decode_base64( $fzup_retFrame1 );
    if(ref $fzup_retFrame1){
      $fzup_retFrame3 = '';
    }else{
      $cbc = Crypt::Mode::CBC->new('AES');
      $fzup_retFrame3 = $cbc->decrypt($fzup_retFrame2, $fzup_key1, chr(0) x 16);
      $fzup_retFrame3 =~ s/\0+$//; 
    }

    # repeat request while out of sequence
    if($fzup_retcode eq '6101'){
      my $fzup_retFrame4 = $xml->XMLin($fzup_retFrame3);  
      $self->{_fzup_lastseq} = $fzup_retFrame4->{'seq'} ;
    }
  
  }while($fzup_retcode && $fzup_retcode eq "6101");

  return [$fzup_retcode, $self->{_fzup_lastseq}, $fzup_retFrame3];

} ## end sub submit

1;


en-234-api-perl.txt ยท Last modified: 2017/06/19 17:46 by admin

Page Tools