[MacPerl] Mac::Glue / Keychain Scripting

[Chris Nandor <pudge@pobox.com>]

I needed some access to the keychain, so I figured out how to access it with Mac::Glue.  Yum!

#!perl -w
use Mac::Glue ':all';
use strict;

$| = 1;

my $name = 'Mac::Glue Test';
my $acct = $ENV{USER} || 'user';

print <<EOT;
This script will lock, then unlock your Keychain (after you supply
the password), create a test key, print out all the usernames and
passwords in your Keychain, search for the test key, and delete
the test key.  If you do not want to perform these possibly
dangerous actions, type "no" and Return.  Else, hit return.
EOT

chomp(my $ans = <STDIN>);
exit if $ans =~ /no/i;

my $keychain = new Mac::Glue 'Keychain Scripting';
$keychain->ERRORS(\&handle_errors);

{ # lock/unlock keychain
	$keychain->lock;
	$keychain->unlock;
}

{ # make new key
	my $key = $keychain->make(
		at	=> location('end' => $keychain->obj(keychain => 1)),
		new	=> 'internet key'
	);
	$keychain->set($keychain->prop(name => $key), to => $name);
	$keychain->set($keychain->prop(account => $key), to => $acct);
	$keychain->set($keychain->prop(password => $key), to => 'beav1s');
}

{ # get all keychain data
	for my $key ($keychain->get($keychain->obj('keys' => keychain => 1))) {
		my %data;
		for (qw(name account password)) {
			$data{$_} = $keychain->get($keychain->prop($_ => $key));
		}
		next if $data{account} eq 'KCSettings_ACCT';
		printf "%-32s: %s, %s\n", @data{qw(name account password)};
	}
}

{ # get/delete test data
	my $key = $keychain->get($keychain->obj(key => whose(AND =>
			[name		=> equals => $name],
			[account	=> equals => $acct],
		), keychain => 1
	));

	print "\nFinding password of key '$name' / '$acct': ";
	print $keychain->get($keychain->prop(password => $key)), "\n";

	print "\Deleting key '$name' / '$acct'.\n";
	$keychain->delete($key);
}

{ # clean up
	$keychain->lock;
	$keychain->quit;
}

sub handle_errors {
	my @err = @_;
	my $error = $err[1]->{ERROR} || $^E;
	die "$err[2]\->$err[3]() error: $error";	
}

__END__



-- 
Chris Nandor                      pudge@pobox.com    http://pudge.net/
Open Source Development Network    pudge@osdn.com     http://osdn.com/

# ===== Want to unsubscribe from this list?
# ===== Send mail with body "unsubscribe" to macperl-request@macperl.org