view release on metacpan or  search on metacpan

GNORBA.pm  view on Meta::CPAN

package GNOME::GNORBA;

use strict;
use vars qw($VERSION @ISA);

require DynaLoader;
require Carp;

require GNOME::GOAD;

@ISA = qw(DynaLoader);


$VERSION = '0.1.0';

bootstrap GNOME::GNORBA $VERSION;

use Fcntl qw(LOCK_EX LOCK_UN O_CREAT O_EXCL O_WRONLY O_RDONLY);

my $COOKIE_LENGTH = 63;

sub get_cookie_reliably {
    my $setme = shift;

    # We assume that if we could get this far, then /tmp/orit-$username
    # is already secured (because of CORBA_ORB_init)
    
    my $pwname = getpwuid($<);
#    my $name = "/tmp/orbit-$pwname/cookie";
    my $name = "/tmp/orbit-cookie";
    
    if (defined $setme) {
	if (!sysopen COOKIEFILE, $name, O_CREAT | O_WRONLY, 0600) {
	    warn "GNOME::GNORBA: Could not create cookie file: $!\n";
	    return undef;
	}
	
	flock (COOKIEFILE, LOCK_EX);
	my $result = syswrite COOKIEFILE, $setme;
	flock (COOKIEFILE, LOCK_UN);
	
	if (!$result) {
	    warn "GNOME::GNORBA: Error writing to cookie file: $!\n";
	    close COOKIEFILE;
	    unlink $name;
	    return undef;
	}

	if (!close COOKIEFILE) {
	    warn "GNOME::GNORBA: Error writing to cookie file: $!\n";
	    close COOKIEFILE;
	    unlink $name;
	    return undef;
	}

	return $setme;
    } else {

	my $buf;
	
	# Create the file exclusively with permissions rw for the
	# user.  if this fails, it means the file already existed
	#
	if (sysopen COOKIEFILE, $name, O_CREAT|O_EXCL|O_WRONLY, 0600) {
	    
	    $buf = " " x $COOKIE_LENGTH;
	    for my $i (0..length($buf)-1) {
		substr($buf, $i, 1, chr(rand(126-33) + 33));
	    }
	    flock (COOKIEFILE, LOCK_EX);
	    my $result = syswrite COOKIEFILE, $buf;
	    flock (COOKIEFILE, LOCK_UN);

	    if (!$result) {
		warn "GNOME::GNORBA: Error writing to cookie file: $!\n";
		close COOKIEFILE;
		unlink $name;
		return undef;
	    }
	    if (!close COOKIEFILE) {
		warn "GNOME::GNORBA: Error writing to cookie file: $!\n";
		close COOKIEFILE;
		unlink $name;
		return undef;
	    }

	} else {
	    if (!sysopen COOKIEFILE, $name, O_RDONLY) {