Re: CVM access from perl?

On Wed, 27 Apr 2005, Charlie Brady wrote:

> On Wed, 27 Apr 2005, Scott Gifford wrote:
...
>> I don't, but if I were writing it, I'd use Inline::C to link directly
>> with the CVM libraries.
>
> It looks to me that the binary protocol is simple enough that a pure perl
> implementation would be easier.

And this seems to work for me:

#!/usr/bin/perl -w
use Socket;
use strict;

sub _genfactnames
{
     my $n = 1;
     return map { $n++, "CVM_FACT_$_" }
     qw(
     USERNAME
     USERID
     GROUPID
     REAL_NAME
     DIRECTORY
     SHELL
     GROUPNAME
     SUPP_GROUPID
     SYS_USERNAME
     SYS_DIRECTORY
     OFFICE_LOCATION
     WORK_PHONE
     HOME_PHONE
     DOMAIN
     MAILBOX
     );
}

my %factnames = _genfactnames();

sub auth
{
     my ($user, $password, $host) = @_;
     $host ||= "localhost";

     my $rendezvous = '/var/lib/cvm/cvm-unix-local.socket';

     unless (socket(SOCK, PF_UNIX, SOCK_STREAM, 0))
     {
         warn "socket: $!";
         return undef;
     }
     unless (connect(SOCK, sockaddr_un($rendezvous)))
     {
         warn "connect: $!";
         return undef;
     }

     my $o = select(SOCK);
     $| = 1;
     select($o);

     print SOCK
         pack("CZ*Z*Z*C", 1, $user, $host, $password, 0);

     shutdown SOCK, 1;

     my $ret = <SOCK>;

     if (my $s = unpack("C", $ret))
     {
         #warn "auth failed with status $s";
         return undef;
     }

     my $n = $ret =~ tr/\0// - 2;
     #print "There are $n facts\n";
     my (undef, @facts) = unpack("C (CZ*)$n", $ret);
     my %facts;
     my $f = shift @facts;
     while ($f)
     {
         my $v = shift @facts;
         #print "Fact ", $factnames{$f}, " is $v\n";
         push @{$facts{$factnames{$f}}}, $v;
         $f = shift @facts;
     }
     return \%facts;
}

my $auth = auth("username", "yyyyy");
die "Auth failed" unless $auth;

foreach my $fact (keys %$auth)
{
     my @values = @{$$auth{$fact}};
     print "Fact $fact has values ", join(',', @values), "\n";
}
exit;