
#	2 bytes		Family value (second byte is as in protocol HOST)
#	2 bytes		address length (always MSB first)
#	A bytes		host address (as in protocol HOST)
#	2 bytes		display "number" length (always MSB first)
#	S bytes		display "number" string
#	2 bytes		name length (always MSB first)
#	N bytes		authorization name string
#	2 bytes		data length (always MSB first)
#	D bytes		authorization data string
# define FamilyLocal (256)	/* not part of X standard (i.e. X.h) */
# define FamilyWild  (65535)
# define FamilyNetname    (254)   /* not part of X standard */
# define FamilyKrb5Principal (253) /* Kerberos 5 principal name */
# define FamilyLocalHost (252)	/* for local non-net authentication */
# from X.h,
# "FamilyChaos", 2,
# "FamilyDECnet", 1,
# "FamilyInternet", 0,

$X::defines{"FamilyLocal"} = 256;

sub unpack_xauth_record { # $data
    my ($data) = @_;
    my ($family, $len, $addr, $disp, $authname, $authdata);
    ($family, $len, $data) = unpack("nna*", $data);
    ($addr, $data) = unpack("a$len a*", $data);
    ($len, $data) = unpack("na*", $data);
    ($disp, $data) = unpack("a$len a*", $data);
    ($len, $data) = unpack("na*", $data);
    ($authname, $data) = unpack("a$len a*", $data);
    ($len, $data) = unpack("na*", $data);
    ($authdata, $data) = unpack("a$len a*", $data);
    return { "family" => $family,
	     "addr"   => $addr,
	     "disp"   => $disp,
	     "authname" => $authname,
	     "authdata" => $authdata,
	     "remainder" => $data};
}

sub parse_xauth_file {
    my $xadb = ();
    my $data;
    {
	my $xafile = defined($ENV{"XAUTHORITY"})?
	    $ENV{"XAUTHORITY"}: ($ENV{"HOME"}."/.Xauthority"); 
	local *XAUTH;
	open(XAUTH, "<$xafile") || return $xadb;
	local $/ = undef;
	$data = <XAUTH>;
	close XAUTH;
    }
    while(length($data)) {
	my $res = unpack_xauth_record($data);
	my $tmprec = {};
	$data = $res->{"remainder"};
	foreach (sort keys %$res) {
	    next if /^remainder$/;
	    $tmprec->{$_} = $res->{$_};
	}
	push(@$xadb, $tmprec);
    }
    return $xadb;
}

sub debug_xauth_file {
    my $xdb = parse_xauth_file();
    foreach (@$xdb) {
	my $res = $_;
	foreach (sort keys %$res) {
	    if (/^addr$/ && length($res->{$_}) == 4) { # 
		print "$_: ",join(".",unpack("C4",$res->{$_})),"\n";
		next;
	    }
	    print "$_: ",unpack("H*",$res->{$_}),"\n"
		if /^authdata$/;
	    next if /^authdata$/;
	    
	    print "$_: $res->{$_}\n";
	}
    }
}

sub search_xauth_file { # display
    my($displayname) = @_;
    my $xdb = parse_xauth_file();
    my ($family, $addr, $res);
    # display cases:
    # :0.* -- unix, so family = FamilyLocal, addr=`hostname`
    # host:0.* -- inet, so family = FamilyInternet, addr = 4byte ip addr
    my($node, $off, $screen);
    ($node, $off, $screen) = split_display($displayname);
    if ($node eq "") {
	# unix domain socket case
	$family = $X::defines{"FamilyLocal"};
	$addr = `hostname`; chomp $addr;
    } else {
	# tcp case
	$family = $X::defines{"FamilyInternet"};
	my ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($node);
	$addr = $thisaddr;
    }

    foreach $res (@$xdb) {
	if ($res->{"family"} eq $family
	    && $res->{"addr"} eq $addr) {
	    return $res;
	}
    }
    return undef;
}

# debug_xauth_file();
1;
