macs-cvs

[Mario D. S. <sa...@us...>]

Update of /cvsroot/macs/macs/sedabl/perl
In directory sc8-pr-cvs1:/tmp/cvs-serv29292/sedabl/perl

Added Files:
	sedabl.i sample4.pl sample3.pl sample2.pl sample1.pl 
	Makefile.am 
Log Message:
Initial checkin of SeDaBl API implementation


--- NEW FILE: sedabl.i ---
#ifdef SWIG
%module SeDaBl
%{
#include "sedabl.h"
%}
/* This tells SWIG how to turn a perl string into arguments for sedabl_new_val */
%typemap(perl5,in) (const void *val,long len) {
  $1 = SvPV_nolen($input);
  if (!$1) SWIG_croak("Type error in argument $argnum of $symname: couldn't get a string");
  $2 = (long) sv_len($input);
}
/* This tells SWIG how to turn a perl string into a sedabl_val */
%typemap(perl5,in) sedabl_val * {
  char *p;
  p = SvPV_nolen($input);
  if (!p) {
    SWIG_croak("Error in argument $argnum of $symname: couldn't get string");
  }
  $1 = malloc(sizeof(sedabl_val));
  if (!$1) {
    SWIG_croak("Error in argument $argnum of $symname: couldn't allocate memory");
  }
  $1->len = (long) sv_len($input);
  $1->val = malloc($1->len);
  if (!$1->val) {
    free($1);
    SWIG_croak("Error in argument $argnum of $symname: couldn't allocate memory");
  }
  memcpy($1->val,p,$1->len);
}
/* "sedabl_val *" arguments that need to be free()d are named "val" */
%typemap(perl5,freearg) sedabl_val *val {
  free($1);
}
/* This tells SWIG how to turn a sedabl_val into a perl string */
%typemap(perl5,out) sedabl_val * {
  $result = newSVpv($1->val,(STRLEN)$1->len);
  sv_2mortal($result);
  argvi++;
}


/* This tells SWIG how to turn a perl array into a sedabl_list */
%typemap(perl5,in) sedabl_list * {
  AV *tmpav;
  long i;
  SV **tmpsv;

  if ($input == &PL_sv_undef) {
    $1 = NULL;
  } else {
    if (!SvROK($input))
      SWIG_croak("Argument $argnum is not a reference.");
    if (SvTYPE(SvRV($input)) != SVt_PVAV)
      SWIG_croak("Argument $argnum is not an array.");
    if (!($1 = malloc(sizeof(sedabl_list))))
      SWIG_croak("Error in argument $argnum of $symname: couldn't allocate memory");
    tmpav = (AV*)SvRV($input);
    $1->elements = $1->max_elts = av_len(tmpav) + 1;
    for (i=0; i < $1->elements; i++) {
      tmpsv = av_fetch(tmpav,i,0);	
      /* if (SWIG_ConvertPtr(*tmpsv,(void *)($1->blocks+i),$descriptor(_sedabl_block_struct *),0) < 0) */
      if (SWIG_ConvertPtr(*tmpsv,(void *)$1->blocks[i],SWIGTYPE_p_sedabl_block,0) < 0)
	SWIG_croak("Type error in argument $argnum of $symname: expected array of $1_descriptor");
    }
  }
}
/* This tells SWIG how to turn a sedabl_list into a perl array */
%typemap(perl5,out) sedabl_list * {
  long i;
  SV **svs;
  AV *myav;
  if (!(svs = (SV **) malloc($1->elements*sizeof(SV *))))
    SWIG_croak("Error in argument $argnum of $symname: couldn't allocate memory");
  for (i=0; i < $1->elements ; i++) {
    svs[i] = sv_newmortal();
    /* SWIG_MakePtr(svs[i],(void *)($1->blocks+i),$descriptor(_sedabl_block_struct *),0); */
    SWIG_MakePtr(svs[i],(void *)$1->blocks[i],SWIGTYPE_p_sedabl_block,0);
  }
  myav = av_make($1->elements,svs);
  free(svs);
  $result = newRV((SV*)myav);
  sv_2mortal($result);
  argvi++;
}
#endif

%include "sedabl.h"
--- NEW FILE: sample4.pl ---

use SeDaBl;

use Carp;
sub DIE { croak("Failed to create message block"); }

# \brief Create message block.
# \return The new message block, or undef on failure.
#
# Notice the algorithm here for creating the nested structure of this
# block.  As inner blocks are created, they are added to their parent
# block before being populated.  This minimizes the amount of time a
# new block remains orphaned, and makes error handling and recovery
# easier (indeed, possible!)  The code for this function is indented
# to represent the nesting level of the the block being worked on.
sub mkblk {
    my ($message, $status, $substatus, $profile);

    # create message, populate value sub-blocks
    $message = sedabl_new_listblock("message",undef) or DIE();
    -1 == sedabl_add_str($message,"msgid","8hgGg33b-a_aj=+2") and DIE();
    -1 == sedabl_add_str($message,"svc","LMC") and DIE();
    -1 == sedabl_add_str($message,"op","LOGIN") and DIE();

    # create status block, add to message
    $status = sedabl_new_listblock("status",undef) or DIE();
    -1 == sedabl_add_block($message,$status) and DIE();

      # create first substatus, add to status, populate with values
      $substatus = sedabl_new_listblock(undef,undef) or DIE();
      -1 == sedabl_add_block($status,$substatus) and DIE();
      -1 == sedabl_add_str($substatus,"reply","YES") and DIE();
      -1 == sedabl_add_str($substatus,"login","user1") and DIE();
      -1 == sedabl_add_str($substatus,"key","username1") and DIE();
        # create profile block, add to substatus, populate
        $profile = sedabl_new_listblock("profile",undef) or DIE();
	-1 == sedabl_add_block($substatus,$profile) and DIE();
	-1 == sedabl_add_str($profile,"macs_name_space/macs/user/email","username1\@yahoo.com") and DIE();

      # create second substatus, add to status, populate with values
      $substatus = sedabl_new_listblock(undef,undef) or DIE();
      -1 == sedabl_add_block($status,$substatus) and DIE();
      -1 == sedabl_add_str($substatus,"reply","NO") and DIE();
      -1 == sedabl_add_str($substatus,"login","user2") and DIE();

      # create third substatus, add to status, populate with values
      $substatus = sedabl_new_listblock(undef,undef) or DIE();
      -1 == sedabl_add_block($status,$substatus) and DIE();
      -1 == sedabl_add_str($substatus,"reply","YES") and DIE();
      -1 == sedabl_add_str($substatus,"login","user3") and DIE();
      -1 == sedabl_add_str($substatus,"key","username3") and DIE();
        # create profile block, add to substatus, populate
        $profile = sedabl_new_listblock("profile",undef) or DIE();
	-1 == sedabl_add_block($substatus,$profile) and DIE();
	-1 == sedabl_add_str($profile,"macs_name_space/macs/user/email","username3\@yahoo.com") and DIE();
  
  return $message;
}

# Helper macro used by showblk to indent lines before printing.
sub INDENT { for (1..$_[0]) { print "\t"; } }

# \brief Display a SeDaBl block's contents
# \param block The block to display.
# \param depth The depth of the given block.  (Use 0.)
# \return 0 on failure, 1 on success.
sub showblk {
    my($block,$depth) = @_;
    my $i, $f;
    
    if (!$block) { return 0; } # no block to display
    INDENT($depth); print "Key:",sedabl_block_key($block);
    if (sedabl_block_is_list($block)) {
	printf(", is a list:\n");
	for (@{sedabl_block_elements($block)}) { # for each sub-block...
	    return 0 unless showblk($_,$depth+1); # ...try to display it
	}
	return 1;
    } else {
	print ", is a value.  As string:\n"; INDENT($depth);
	print "\t``",sedabl_block_value($block),"''\n";
	return 1;
    }
}

my $msg;
my $fh, $fd;
  
die unless $msg = mkblk();

die unless open($fh,">/tmp/sedable.out");
$fd = fileno($fh);
die("sedabl_write failed: $!") unless sedabl_write($fd,$msg);
close($fh);
print "Wrote the following block:\n";
die unless showblk($msg,0);
sedabl_free($msg);

die unless open($fd,"</tmp/sedable.out");
die ("sedabl_read failed: $!") unless $msg = sedabl_read($fd);
close($fh);
print "Read the following block:\n";
die unless showblk($msg,0);

print "\n\n****** Now multiple reads and writes...\n\n\n";

die unless open($fh,">/tmp/sedable.out");
$fd = fileno($fh);
die("sedabl_write failed: $!") unless sedabl_write($fd,$msg);
die("sedabl_write failed: $!") unless sedabl_write($fd,$msg);
die("sedabl_write failed: $!") unless sedabl_write($fd,$msg);
close($fh);
print "Wrote the following block:\n";
die unless showblk($msg,0);

die unless open($fh,"</tmp/sedable.out");
$fd = fileno($fh);
die ("sedabl_read failed: $!") unless $msg = sedabl_read($fd);
sedabl_free($msg);
die ("sedabl_read failed: $!") unless $msg = sedabl_read($fd);
sedabl_free($msg);
die ("sedabl_read failed: $!") unless $msg = sedabl_read($fd);
close($fh);
print "Read the following block:\n";
die unless showblk($msg,0);
sedabl_free($msg);

--- NEW FILE: sample3.pl ---

use SeDaBl;

use Carp;
sub DIE { croak("Failed to create message block"); }

# \brief Create message block.
# \return The new message block, or undef on failure.
#
# Notice the algorithm here for creating the nested structure of this
# block.  As inner blocks are created, they are added to their parent
# block before being populated.  This minimizes the amount of time a
# new block remains orphaned, and makes error handling and recovery
# easier (indeed, possible!)  The code for this function is indented
# to represent the nesting level of the the block being worked on.
sub mkblk {
    my ($message, $status, $substatus, $profile);

    # create message, populate value sub-blocks
    $message = sedabl_new_listblock("message",undef) or DIE();
    -1 == sedabl_add_str($message,"msgid","8hgGg33b-a_aj=+2") and DIE();
    -1 == sedabl_add_str($message,"svc","LMC") and DIE();
    -1 == sedabl_add_str($message,"op","LOGIN") and DIE();

    # create status block, add to message
    $status = sedabl_new_listblock("status",undef) or DIE();
    -1 == sedabl_add_block($message,$status) and DIE();

      # create first substatus, add to status, populate with values
      $substatus = sedabl_new_listblock(undef,undef) or DIE();
      -1 == sedabl_add_block($status,$substatus) and DIE();
      -1 == sedabl_add_str($substatus,"reply","YES") and DIE();
      -1 == sedabl_add_str($substatus,"login","user1") and DIE();
      -1 == sedabl_add_str($substatus,"key","username1") and DIE();
        # create profile block, add to substatus, populate
        $profile = sedabl_new_listblock("profile",undef) or DIE();
	-1 == sedabl_add_block($substatus,$profile) and DIE();
	-1 == sedabl_add_str($profile,"macs_name_space/macs/user/email","username1\@yahoo.com") and DIE();

      # create second substatus, add to status, populate with values
      $substatus = sedabl_new_listblock(undef,undef) or DIE();
      -1 == sedabl_add_block($status,$substatus) and DIE();
      -1 == sedabl_add_str($substatus,"reply","NO") and DIE();
      -1 == sedabl_add_str($substatus,"login","user2") and DIE();

      # create third substatus, add to status, populate with values
      $substatus = sedabl_new_listblock(undef,undef) or DIE();
      -1 == sedabl_add_block($status,$substatus) and DIE();
      -1 == sedabl_add_str($substatus,"reply","YES") and DIE();
      -1 == sedabl_add_str($substatus,"login","user3") and DIE();
      -1 == sedabl_add_str($substatus,"key","username3") and DIE();
        # create profile block, add to substatus, populate
        $profile = sedabl_new_listblock("profile",undef) or DIE();
	-1 == sedabl_add_block($substatus,$profile) and DIE();
	-1 == sedabl_add_str($profile,"macs_name_space/macs/user/email","username3\@yahoo.com") and DIE();
  
  return $message;
}

# Helper macro used by showblk to indent lines before printing.
sub INDENT { for (1..$_[0]) { print "\t"; } }

# \brief Display a SeDaBl block's contents
# \param block The block to display.
# \param depth The depth of the given block.  (Use 0.)
# \return 0 on failure, 1 on success.
sub showblk {
    my($block,$depth) = @_;
  my $i, $f;

  if (!$block) { return 0; } # no block to display
  INDENT($depth); print "Key:",sedabl_block_key($block);
  if (sedabl_block_is_list($block)) {
    printf(", is a list:\n");
    for (@{sedabl_block_elements($block)}) { # for each sub-block...
	return 0 unless showblk($_,$depth+1); # ...try to display it
    }
    return 1;
  } else {
    print ", is a value.  As string:\n"; INDENT($depth);
    print "\t``",sedabl_block_value($block),"''\n";
    return 1;
  }
}

!showblk(mkblk(),0);

--- NEW FILE: sample2.pl ---
use SeDaBl;

my $uid = 12;
my $skey = "ajshdfkh";
my $svc = "AUS";
my $method;
my $methods = ["YAHOO", "ESPN", "LDAP"];
my $op = "AUTH";
my $lb;
my $v;
my $p;
my $len;

print "creating listblock\n";
$lb = sedabl_new_listblock("outer",undef);

print "\tadding uid/$uid@".
    sedabl_add_val($lb,"uid",$uid)."\n";

print "\tadding skey/$skey@".
    sedabl_add_val($lb,"skey",$skey)."\n";

printf "\tadding svc/$svc@".
    sedabl_add_val($lb,"svc",$svc)."\n";

print "\tcreating method listblock\n";
$method = sedabl_new_listblock("method",undef);
print "\tadding method/$method@".
    sedabl_add_block($lb,$method)."\n";
for (@$methods) {
    print "\t\tadding method $_@".
	sedabl_add_val($method,undef,$_)."\n";
}

print "\tadding op/$op@".
    sedabl_add_val($lb,"op",$op)."\n";

print "\tdemarshalling\n";
$v=sedabl_demarshal($lb);
sedabl_free($lb);

printf("v->val now points to a v->len-sized block of core\n");
printf("which can, eg, be written to a file or socket\n\n");
# -- LATER --

print "marshalling\n";
$lb=sedabl_marshal($v);
if ($lb == -1) {
    print STDERR "Incomplete block during round trip!\n";
    exit(1);
}
if (!$lb) {
    print STDERR "Invalid byte string during round trip!\n";
    exit(1);
}

$uid=sedabl_get_val($lb,"uid",-1);
print "\tgot uid ($uid)\n";

$skey=sedabl_get_val($lb,"skey",-1);
print "\tgot skey ($skey)\n";

$svc=sedabl_get_val($lb,"svc",-1);
print "\tgot svc ($svc)\n";

$method=sedabl_get_block($lb,"method",-1);
print "\tgot method list";
print sedabl_block_is_list($method)
    ? ", and it looks good.\n"
    : ", but it doesn't seem to be a list!\n";
$methods = sedabl_block_elements($method);
if (!@$methods) {
    print "\t\tNo element blocks in method list!\n";
} else {
    print "\t\tWe have ",$#$methods+1," methods...\n";
    for (@$methods) {
	print "\t\tGot method (",sedabl_block_value($_),")\n";
    }
}

$op=sedabl_get_val($lb,"op",-1);
print "\tgot op ($op)\n";

sedabl_free($lb);

--- NEW FILE: sample1.pl ---
use SeDaBl;

my $uid = 12;
my $skey = "ajshdfkh";
my $svc = "AUS";
my $method = "YAHOO";
my $op = "AUTH";
my $lb;
my $v;
my $p;
my $len;

print "creating listblock\n";
$lb = sedabl_new_listblock("outer",undef);

print "\tadding uid/$uid@".
    sedabl_add_val($lb,"uid",$uid)."\n";

print "\tadding skey/$skey@".
    sedabl_add_val($lb,"skey",$skey)."\n";

printf "\tadding svc/$svc@".
    sedabl_add_val($lb,"svc",$svc)."\n";

print "\tadding method/$method@".
    sedabl_add_val($lb,"method",$method)."\n";

print "\tadding op/$op@".
    sedabl_add_val($lb,"op",$op)."\n";

print "\tdemarshalling\n";
$v=sedabl_demarshal($lb);
sedabl_free($lb);

printf("v->val now points to a v->len-sized block of core\n");
printf("which can, eg, be written to a file or socket\n\n");
# -- LATER --

print "marshalling\n";
$lb=sedabl_marshal($v);
if ($lb == -1) {
    print STDERR "Incomplete block during round trip!\n";
    exit(1);
}
if (!$lb) {
    print STDERR "Invalid byte string during round trip!\n";
    exit(1);
}

$uid=sedabl_get_val($lb,"uid",-1);
print "\tgot uid ($uid)\n";

$skey=sedabl_get_val($lb,"skey",-1);
print "\tgot skey ($skey)\n";

$svc=sedabl_get_val($lb,"svc",-1);
print "\tgot svc ($svc)\n";

$method=sedabl_get_val($lb,"method",-1);
print "\tgot method ($method)\n";

$op=sedabl_get_val($lb,"op",-1);
print "\tgot op ($op)\n";

sedabl_free($lb);

--- NEW FILE: Makefile.am ---

modlibdir = $(pkglibdir)
dist_modlib_DATA = SeDaBl.pm
pkglib_LTLIBRARIES = SeDaBl.la
SeDaBl_la_SOURCES = sedabl_wrap.c
SeDaBl_la_CFLAGS = -I.. @PERL_CCFLAGS@ @PERL_CPPFLAGS@
SeDaBl_la_LDFLAGS = -module -shrext @PERL_SHREXT@ -L$(srcdir)/.. -lsedabl
# the next 2 rules use swig if we need to
SeDaBl.pm: sedabl_wrap.c
sedabl_wrap.c: $(srcdir)/../sedabl.h sedabl.i
	@SWIG@ @DEFS@ -I$(srcdir)/.. -perl5 -Wall -includeall -exportall sedabl.i

MAINTAINERCLEANFILES = SeDaBl.pm sedabl_wrap.c
EXTRA_DIST = sedabl.i