Skip to content

Instantly share code, notes, and snippets.

@Moligaloo

Moligaloo/plutil.pl

Created January 30, 2013 08:32
Show Gist options
  • Save Moligaloo/4671659 to your computer and use it in GitHub Desktop.
Save Moligaloo/4671659 to your computer and use it in GitHub Desktop.
Download ZIP
Convert Apple's property list file between binary format and XML format
Raw
plutil.pl
# plutil.pl 1.6 - implementation of binary/UTF-8 (text) XML conversion of plist files
# does not (yet) support OS X plutil command line syntax
# 1.0 - first public release
# 1.1 - added support for date Type 3; fixed real Type 2
# 1.2 - fixed handling of empty arrays
# 1.3 - fixed handling of large strings and empty keys
# 1.4 - write utf8 in XML, convert as necessary on read
# 1.5 - read/write 8 byte integers and negative integers; handle special XML chars in dictionary keys
# - now requires Math::BigInt
# 1.6 - read/write data fields (type 4); also handles funny filenames better
# - now requires MIME::Base64
# 1.7 - correct binary to XML conversion
# Copyright 2007-2008 Starlight Computer Wizardry
use strict;
use Encode qw(decode encode);
use Fcntl qw(:seek);
use Time::Local 'timegm_nocheck';
use POSIX ();
use Math::BigInt;
use MIME::Base64;
my $VERSION = "v1.5";
sub nice_string {
join("",
map { $_ > 255 ? # if wide character...
sprintf("\\x{%04X}", $_) : # \x{...}
chr($_) =~ /[[:cntrl:]]/ ? # else if control character ...
sprintf("\\x%02X", $_) : # \x..
quotemeta(chr($_)) # else quoted or as themselves
} unpack("U*", $_[0])); # unpack Unicode characters
}
my @Offsets;
my ($OffsetSize, $ObjRefSize, $NumObjects, $TopObject, $OffsetTableOffset);
my $OVal;
my ($InX, %Strings);
my $SNum = 0;
my $SLen = 0; # string lens
my $ILen = 0; # int lens
my $MLen = 0; # Misc lens
my $OLen = 0; # object lens
sub GetToken {
$InX =~ s/^\s+//; # skip whitespace
# print "from ",substr($InX, 1, 20)," => ";
if ($InX =~ s/<([^>]+)>//) {
# print "Token: $1\n";
return $1;
}
else {
die "Can't find token at " . substr($InX, 0, 80);
}
}
sub GetNonToken {
my ($t) = @_;
if ($InX =~ s{([^<]*)</$t>}{}) {
return $1;
}
else {
die "can't find end of <$t> at " . substr($InX, 0, 80);
}
}
sub PushToken {
my ($t) = @_;
$InX = "<$t>" . $InX;
}
sub ReadXinteger {
my $s = +GetNonToken("integer");
my $il = 1;
$il += 1 if ($s > 255);
$il += 2 if ($s > 65535);
$il += 4 if ($s > Math::BigInt->new("4294967295"));
$il += 7 if ($s < 0);
$ILen += $il+1;
# print "ILen (int $s) += ", $il+1, "\n";
++$NumObjects;
return ["integer", $s];
}
sub ReadXreal {
my $s = +GetNonToken("real");
$MLen += 9;
# print "MLen (real $s) += 9\n";
++$NumObjects;
return ["real", +$s];
}
sub ReadXdate {
my $s = +GetNonToken("date");
$MLen += 9;
# print "MLen (date $s) += 9\n";
++$NumObjects;
return ["date", +$s];
}
sub CountIntSize {
my ($num) = @_;
my $ans = 0;
$ans += 2 if $num > 14;
$ans += 1 if $num > 255;
$ans += 2 if $num > 65535;
return $ans;
}
sub CountX {
my ($s) = @_;
if (not defined $Strings{$s}) {
++$NumObjects;
$Strings{$s} = ++$SNum;
# print "SLen ('$s' ",length($s),") += ",length($s)+1 + CountIntSize(length($s)),"\n";
$SLen += length($s)+1;
$ILen += CountIntSize(length($s));
}
}
sub ReadXdata {
my $s = +GetNonToken("data");
++$NumObjects;
my $buf = decode_base64($s);
$MLen += length($buf)+1;
print "MLen (data ",unpack("H*",$buf),") += ",length($buf)+1,"\n";
$ILen += CountIntSize(length($buf));
print "ILen (data(",length($buf),")) += ", CountIntSize(length($buf)),"\n";
# print "buf=",unpack("H*",$buf),"\n";
return ["data", $buf];
}
sub UnfixXMLString {
my ($s) = @_;
$s =~ s/&lt;/</g;
$s =~ s/&gt;/>/g;
$s =~ s/&amp;/&/g;
return $s;
}
sub ReadXstring {
my $s = UnfixXMLString(GetNonToken("string"));
CountX($s);
return ["string", $s];
}
sub ReadXustring {
my $s = GetNonToken("ustring");
$s = pack "U0C*", unpack "C*", $s;
if (not defined $Strings{$s}) {
++$NumObjects;
$Strings{$s} = ++$SNum;
# print "SLen ('",nice_string($s),"' ",length($s)*2,") += ",length($s)*2+1 + CountIntSize(length($s)),"\n";
$SLen += length($s)*2+1;
$ILen += CountIntSize(length($s));
}
# now treat as utf8 so binary output will work
return ["ustring", $s];
}
sub ReadXarray {
my @array;
my $j = 0;
while (1) {
my $t = GetToken();
last if ($t eq "/array");
PushToken($t);
my $v = ReadXObject();
++$j;
push @array,$v;
++$OLen; # count each array member
}
++$NumObjects;
++$MLen; # count array type byte
$ILen += CountIntSize(scalar @array);
return ["array", \@array];
}
sub ReadXdict {
my %dict;
my $t = GetToken();
while ($t eq "key") {
my $k = UnfixXMLString(GetNonToken("key"));
CountX($k);
my $v = ReadXObject();
$dict{$k} = $v;
$t = GetToken();
$OLen += 2;
}
die "Missing /dict at $t" if ($t ne "/dict");
++$NumObjects;
++$MLen; # count dict type byte
$ILen += CountIntSize(scalar keys %dict);
return ["dict", \%dict];
}
sub ReadXtrue_ {
++$NumObjects;
$MLen += 1; # type
return ["true", 1];
}
sub ReadXfalse_ {
++$NumObjects;
$MLen += 1; # type
return ["false", 0];
}
sub ReadXObject {
my $t = GetToken();
$t =~ s{/$}{_};
# print "ReadX$t()\n";
my $ans = eval "ReadX" . $t . "()";
die "$@ in ReadXObject" if $@;
return $ans;
}
#my ($OffsetSize, $ObjRefSize, $NumObjects, $TopObject, $OffsetTableOffset);
#my @Offsets;
my @VObjects;
my $ObjNum = 0;
my %WStrings;
sub MakeInt {
my ($anInt) = @_;
my $ans = "";
if ($anInt > 65535) { # 4 byte int
$ans = "\x12" . pack("N", $anInt);
}
elsif ($anInt > 255) { # 2 byte int
$ans = "\x11" . pack("n", $anInt);
}
else {
$ans = "\x10" . pack("C", $anInt);
}
return $ans;
}
sub MakeAType {
my ($typ, $len) = @_;
my $ans = "";
# print "MakeAType($typ,$len)\n";
my $optint = "";
if ($len < 15) {
$typ .= sprintf("%x", $len);
}
else {
$typ .= "f";
$optint = MakeInt($len);
}
# print "typ=$typ\n";
$ans = pack("H*", $typ) . $optint;
return $ans;
}
sub WriteBtrue {
my $oVal = $OVal;
my $objNum = $ObjNum++;
my $t = "\x09";
$VObjects[$objNum] = $t;
# print "#$objNum -> true\n";
return $objNum;
}
sub WriteBfalse {
my $oVal = $OVal;
my $objNum = $ObjNum++;
my $t = "\x08";
$VObjects[$objNum] = $t;
# print "#$objNum -> false\n";
return $objNum;
}
sub WriteBinteger {
my $oVal = $OVal;
my $objNum = $ObjNum++;
my $il = 0;
if ($oVal > 255) {
++$il;
}
if ($oVal > 65535) {
++$il;
}
if ($oVal > Math::BigInt->new("4294967295")) {
++$il;
}
$il = 3 if ($oVal < 0);
my $t = MakeAType("1", $il);
my $buf;
if ($il < 3) {
$buf = pack((($il == 0) ? "C" : (($il == 1) ? "n" : "N" )), $oVal);
}
else {
if ($oVal < 0) {
$oVal += Math::BigInt->new(2)->bpow(64);
}
my $hw = Math::BigInt->new($oVal);
$hw->brsft(32);
my $lw = Math::BigInt->new($oVal);
$lw->band(Math::BigInt->new("4294967295"));
$buf = pack("N", $hw) . pack("N", $lw);
}
$VObjects[$objNum] = $t . $buf;
# print "($il) VObjects[$objNum] = ",unpack("H*", $VObjects[$objNum])," : ";
# print "#$objNum -> $oVal\n";
return $objNum;
}
sub WriteBreal {
my $oVal = $OVal;
my $objNum = $ObjNum++;
my $t = MakeAType("2", 3);
$VObjects[$objNum] = $t . reverse(pack("d", $oVal));
# print "#$objNum -> $oVal\n";
return $objNum;
}
sub WriteBdate {
my $oVal = $OVal;
my $objNum = $ObjNum++;
my ($year,$mon,$mday,$hour,$min,$sec) = unpack "A4xA2xA2xA2xA2xA*",$oVal;
$sec =~ s/Z$//;
my ($fsec,$isec) = POSIX::modf($sec);
# print "Write date $year-$mon-${mday}T$hour:$min:${sec}Z\n";
$oVal = timegm_nocheck($isec,$min,$hour,$mday,$mon-1,$year-1900)-978307200 + $fsec;
my $t = MakeAType("3", 3);
$VObjects[$objNum] = $t . reverse(pack("d", $oVal));
# print "#$objNum -> $oVal\n";
return $objNum;
}
sub WriteBdata {
my $oVal = $OVal;
my $objNum = $ObjNum++;
my $t = MakeAType("4", length($oVal));
# print "data(",length($oVal),")\n";
$VObjects[$objNum] = $t . $oVal;
# print "#$objNum -> ",unpack("H*",$oVal),"\n";
return $objNum;
}
sub WriteBstring {
my $oVal = $OVal;
my $objNum;
if (not defined $WStrings{$oVal}) {
$objNum = $ObjNum++;
$WStrings{$oVal} = $objNum;
my $t = MakeAType("5", length($oVal));
$VObjects[$objNum] = $t . $oVal;
# print "#$objNum -> $oVal\n";
}
else {
$objNum = $WStrings{$oVal};
}
return $objNum;
}
sub WriteBustring {
my $oVal = $OVal;
my $objNum;
if (not defined $WStrings{$oVal}) {
$objNum = $ObjNum++;
$WStrings{$oVal} = $objNum;
my $t = MakeAType("6", length($oVal));
$VObjects[$objNum] = $t . pack("C*", unpack("U*", encode("UTF-16BE", $oVal)));
# print "#$objNum -> ", nice_string($oVal), "\n";
}
else {
$objNum = $WStrings{$oVal};
}
return $objNum;
}
sub WriteBarray {
my $oVal = $OVal;
my $objNum = $ObjNum++;
my $t = MakeAType("a", scalar @$oVal);
for (my $j = 0; $j < @$oVal; ++$j) {
my $vref = WriteB($oVal->[$j]);
# print "[$j] = $vref\n";
$t .= PackIn($ObjRefSize, $vref);
}
$VObjects[$objNum] = $t;
# print "#$objNum = [", unpack("H*", $t), "]\n";
return $objNum;
}
sub WriteBdict {
my $oVal = $OVal;
my $objNum = $ObjNum++;
my $t = MakeAType("d", scalar keys %$oVal);
foreach my $k (sort keys %$oVal) {
my $kref = WriteB(["string", $k]);
$t .= PackIn($ObjRefSize, $kref);
}
foreach my $k (sort keys %$oVal) {
my $vref = WriteB($oVal->{$k});
$t .= PackIn($ObjRefSize, $vref);
}
$VObjects[$objNum] = $t;
# print "#$objNum = {", unpack("H*", $t), "}\n";
return $objNum;
}
sub WriteB {
my ($obj) = @_;
my $oType = $obj->[0];
$OVal = $obj->[1];
my $ans;
if ($oType ne "") {
$ans = eval "WriteB" . $oType . "()";
die "$@ in WriteB" if $@;
}
else {
die "$oType == ''";
}
return $ans;
}
sub TryName {
my ($oldname,$fromtype, $totype, $tryext) = @_;
if ($oldname =~ /\.$fromtype\.$tryext$/) {
print "Found .$fromtype.$tryext\n";
$oldname =~ s/\.$fromtype\.$tryext$/.$totype.$tryext/;
}
elsif ($oldname =~ /\.$tryext$/) {
print "Found .$tryext\n";
$oldname =~ s/\.$tryext$/.$totype.$tryext/;
}
print "TryName: $oldname\n";
return $oldname;
}
sub NewName {
my ($oldname, $fromtype, $totype) = @_;
print "Old: $oldname, from: $fromtype, to: $totype\n";
my $newname = TryName($oldname, $fromtype, $totype, "plist");
$newname = TryName($newname, $fromtype, $totype, "strings");
$newname .= ".$totype" if $newname !~ /$totype/;
return $newname;
}
sub NumBytesNeeded {
my ($num) = @_;
my $ans = 0;
while ($num >= 1) {
++$ans;
$num /= 256;
}
return $ans;
}
sub PackIn {
my ($bytes, $num) = @_;
my $fmt = ["C", "n", "N", "N"]->[$bytes-1];
if ($bytes == 3) {
my $ans = substr(pack($fmt, $num), -3);
# print "PackIn($bytes, $num) = ", unpack("H*", $ans),"\n";
return $ans;
}
else {
return pack($fmt, $num);
}
}
sub ConvertXMLToBinary {
my ($filename) = @ARGV;
my $newname = NewName($filename, "text", "binary");
print "XMLToBinary:\n";
open(INF, "<", $filename) or die "can't open $filename for conversion"; # removed :utf8
readline INF; # skip XML line
readline INF; # skip DTD line
my $verline = readline INF;
chomp $verline;
warn "Unknown plist version $verline" if $verline ne "<plist version=\"1.0\">";
$InX = do { local $/; undef $/; <INF> };
# brute force remove unicode flag
# $InX = pack "C*", unpack "U0C*", $InX;
$NumObjects = 0;
my $top = ReadXObject();
print "NumObjects = $NumObjects\n";
$ObjRefSize = NumBytesNeeded($NumObjects);
print "ObjRefSize = $ObjRefSize\n";
print "String Lengths = $SLen\n";
print "Int Lengths = $ILen\n";
print "Misc Lengths = $MLen\n";
print "$OLen obj refs = ", $OLen * $ObjRefSize, "\n";
my $fileSize = $SLen + $ILen + $MLen + $OLen * $ObjRefSize + 40;
print "Object FileSize = $fileSize\n";
$OffsetSize = NumBytesNeeded($fileSize);
print "OffsetSize = $OffsetSize\n";
print "Total Filesize = ",$fileSize + $NumObjects * $OffsetSize,"\n";
$OffsetTableOffset = $fileSize - 32;
print "OffsetTableOffset = $OffsetTableOffset\n\n";
print "Unique strings = ", scalar keys %Strings,"\n";
$TopObject = 0;
close(INF);
open(OUTF, ">$newname") or die "can't open $newname for output";
binmode(OUTF);
# output magic header
print OUTF "bplist00";
WriteB($top);
my $objOffset = 8;
my @offsets;
for (my $j = 0; $j < @VObjects; ++$j) {
print OUTF $VObjects[$j];
$offsets[$j] = $objOffset;
$objOffset += length($VObjects[$j]);
}
for (my $j = 0; $j < @offsets; ++$j) {
print OUTF PackIn($OffsetSize, $offsets[$j]);
}
print OUTF pack("x6CC", $OffsetSize, $ObjRefSize);
print OUTF pack("x4N", $NumObjects);
print OUTF pack("x4N", $TopObject);
print OUTF pack("x4N", $OffsetTableOffset);
close(OUTF);
}
my %RStrings;
sub ReadBType0 {
my ($objLen) = @_;
my $ans;
if ($objLen == 0) {
$ans = ["null", 0];
}
elsif ($objLen == 8) {
$ans = ["false", 0];
}
elsif ($objLen == 9) {
$ans = ["true", 1];
}
elsif ($objLen == 15) {
$ans = ["fill", 15];
}
++$MLen;
# print $ans->[0],"\n";
return $ans;
}
sub ReadBType1 { # int
my ($objLen) = @_;
die "Integer > 8 bytes = $objLen" if ($objLen > 3);
my $byteLen = 1 << $objLen;
my ($buf, $val);
read(INF, $buf, $byteLen);
if ($objLen == 0) {
$val = unpack("C", $buf);
}
elsif ($objLen == 1) {
$val = unpack("n", $buf);
}
elsif ($objLen == 2) {
$val = unpack("N", $buf);
}
elsif ($objLen == 3) {
# print "buf=",unpack("H*",$buf),"\n";
my ($hw,$lw) = unpack("NN", $buf);
$val = Math::BigInt->new($hw)->blsft(32)->bior($lw);
if ($val->bcmp(Math::BigInt->new(2)->bpow(63)) > 0) {
$val -= Math::BigInt->new(2)->bpow(64);
}
# print "8 byte val: hw; $hw, lw: $lw, val: $val\n";
# $val = unpack("Q", $buf);
# print "8 byte val (Q): $val\n";
}
$ILen += $byteLen+1;
# print "$val\n";
return ["int", $val];
}
sub ReadBType2 { # real
my ($objLen) = @_;
die "Real > 8 bytes" if ($objLen > 3);
my $byteLen = 1 << $objLen;
my ($buf, $val);
read(INF, $buf, $byteLen);
if ($objLen == 0) { # 1 byte float = error?
die "1 byte real found";
}
elsif ($objLen == 1) { # 2 byte float???
die "2 byte real found";
}
elsif ($objLen == 2) {
$val = unpack("f", reverse $buf);
}
elsif ($objLen == 3) {
$val = unpack("d", reverse $buf);
}
$MLen += 9;
# print "$val\n";
return ["real", $val];
}
sub ReadBType3 { # date
my ($objLen) = @_;
die "Date > 8 bytes" if ($objLen > 3);
my $byteLen = 1 << $objLen;
my ($buf, $val);
read(INF, $buf, $byteLen);
if ($objLen == 0) { # 1 byte NSDate = error?
die "1 byte NSDate found";
}
elsif ($objLen == 1) { # 2 byte NSDate???
die "2 byte NSDate found";
}
elsif ($objLen == 2) {
$val = unpack("f", reverse $buf);
}
elsif ($objLen == 3) {
$val = unpack("d", reverse $buf);
}
$MLen += 9;
# print "$val\n";
return ["date", $val];
}
sub ReadBType4 { # binary data
my ($byteLen) = @_;
my $buf;
read(INF, $buf, $byteLen);
$MLen += $byteLen+1;
# print "buf($byteLen)=",unpack("H*",$buf),"\n";
return ["data", $buf];
}
sub ReadBType5 { # byte (utf8?) string
my ($objLen) = @_;
my $buf;
read(INF, $buf, $objLen);
if (not defined $RStrings{$buf}) {
$SLen += $objLen+1;
# print "SLen ($buf) = ",$objLen+1,"\n";
$RStrings{$buf} = 1;
}
else {
$ILen -= CountIntSize($objLen);
}
$buf = pack "U0C*", unpack "C*", $buf; # mark as Unicode
# print "$buf\n";
return ["string", $buf];
}
sub ReadBType6 { # unicode string
my ($objLen) = @_;
my $buf;
read(INF, $buf, 2*$objLen);
if (not defined $RStrings{$buf}) {
$SLen += 2*$objLen+1;
$RStrings{$buf} = 1;
}
else {
$ILen -= CountIntSize($objLen);
}
# print nice_string(decode("UTF-16BE", $buf));
return ["ustring", decode("UTF-16BE", $buf)];
}
sub ReadBTypea { # array
my ($objLen) = @_;
my @array;
# read objrefs
my $buf;
read(INF, $buf, $objLen * $ObjRefSize);
my @objs = unpack(($ObjRefSize == 1 ? "C*" : "n*"), $buf);
for (my $j = 0; $j < $objLen; ++$j) {
my $obj = ReadBObjectAt($objs[$j]);
$array[$j] = $obj;
}
++$MLen;
# print "array\n";
return ["array", \@array];
}
sub ReadBTyped { # dictionary
my ($objLen) = @_;
my %dict;
# print "dict\n";
# read keys
my $buf;
read(INF, $buf, $objLen * $ObjRefSize);
my @keys = unpack(($ObjRefSize == 1 ? "C*" : "n*"), $buf);
# read objrefs
read(INF, $buf, $objLen * $ObjRefSize);
my @objs = unpack(($ObjRefSize == 1 ? "C*" : "n*"), $buf);
for (my $j = 0; $j < $objLen; ++$j) {
# print "\t= ";
my $key = ReadBObjectAt($keys[$j])->[1];
# print " -> ";
my $obj = ReadBObjectAt($objs[$j]);
$dict{$key} = $obj;
}
++$MLen;
# print "\n";
return ["dict", \%dict];
}
sub ReadBObject {
# get object type/size
my $buf;
if (read(INF, $buf, 1) != 1) {
die "Didn't read type byte: $!";
}
my $objLen = unpack("C*", $buf) & 0xF;
$buf = unpack("H*", $buf);
my $objType = substr($buf, 0, 1);
if ($objType ne "0" && $objLen == 15) {
$objLen = ReadBObject()->[1];
}
# print "ReadBType $objType ( $objLen )\n";
my $ans = eval "ReadBType" . $objType . "($objLen)";
die "$@ in ReadBObject" if $@;
return $ans;
}
sub ReadBObjectAt {
my ($objNum) = @_;
# print "#$objNum @(", $Offsets[$objNum],")= ";
seek(INF, $Offsets[$objNum], SEEK_SET);
return ReadBObject();
}
my ($Indent);
sub FixXMLString {
my ($in) = @_;
$in =~ s/&/&amp;/g;
$in =~ s/</&lt;/g;
$in =~ s/>/&gt;/g;
return $in;
}
sub WriteXMLstring {
my $oVal = $OVal;
print OUTF "\t" x $Indent,"<string>",FixXMLString($oVal),"</string>\n";
}
sub WriteXMLtrue {
print OUTF "\t" x $Indent,"<true/>\n";
}
sub WriteXMLfalse {
print OUTF "\t" x $Indent,"<false/>\n";
}
sub WriteXMLint {
my $oVal = $OVal;
print OUTF "\t" x $Indent,"<integer>$oVal</integer>\n";
}
sub WriteXMLreal {
my $oVal = $OVal;
print OUTF "\t" x $Indent,"<real>";
my $ans = sprintf "%.25f", $oVal;
$ans =~ s/0+$//;
print OUTF "$ans</real>\n";
}
sub WriteXMLdate { # note: CFDate is a double = # seconds since 1/1/2001 0:0:0 GMT
# Windows Perl epoch 1/1/1970 0:0:0 UTC so difference is 978307200
my $oVal = $OVal;
print "date $oVal\n";
my ($fsec,$iVal) = POSIX::modf($oVal);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(978307200+$iVal);
print OUTF "\t" x $Indent,"<date>";
printf OUTF "%04d-%02d-%02dT%02d:%02d:%.6fZ", $year+1900,$mon+1,$mday,$hour,$min,$sec+$fsec;
print OUTF "</date>\n";
}
sub WriteXMLdata {
my $oVal = $OVal;
print "oVal=",unpack("H*",$oVal),"\n";
my $ind = "\t" x $Indent;
print OUTF "$ind<data>\n";
my $buf = encode_base64($oVal,"");
print "buf=\n$buf\n";
# limit lines to 76 chars, counting tabs as 8 chars
my $len = 76 - 8 * $Indent;
my @lines = unpack("(a$len)*",$buf);
foreach (@lines) {
print OUTF $ind,$_,"\n";
}
print OUTF $ind, "</data>\n";
}
sub WriteXMLustring {
my $oVal = $OVal;
$oVal =~ s/&/&amp;/g;
$oVal =~ s/</&lt;/g;
$oVal =~ s/>/&gt;/g;
print OUTF "\t" x $Indent,"<ustring>$oVal</ustring>\n";
}
sub WriteXMLarray {
my $oVal = $OVal;
print OUTF "\t" x $Indent,"<array>\n";
++$Indent;
foreach my $v (@$oVal) {
WriteXML($v);
}
--$Indent;
print OUTF "\t" x $Indent,"</array>\n";
}
sub WriteXMLdict {
my $oVal = $OVal;
print OUTF "\t" x $Indent,"<dict>\n";
++$Indent;
foreach my $k (sort keys %$oVal) {
print OUTF "\t" x $Indent,"<key>",FixXMLString($k),"</key>\n";
WriteXML($oVal->{$k});
}
--$Indent;
print OUTF "\t" x $Indent,"</dict>\n";
}
sub WriteXML {
my ($obj) = @_;
my $oType;
($oType, $OVal) = @$obj;
if ($oType ne "") {
eval "WriteXML" . $oType . "()";
die "$@ in WriteXML" if $@;
}
else {
die "$oType is null!";
}
}
sub WriteTopXML {
$Indent = 0;
WriteXML(@_);
}
sub ConvertBinaryToXML {
my ($filename) = @_;
my $newname = NewName($filename, "binary", "text");
print "BinaryToXML:\n";
open(INF, $filename) or die "can't open $filename for conversion";
binmode(INF);
open(OUTF, ">:utf8", "$newname") or die "can't open $newname for output";
# get trailer
seek(INF, -32, SEEK_END);
my $buf;
read(INF, $buf, 32);
($OffsetSize, $ObjRefSize, $NumObjects, $TopObject, $OffsetTableOffset) = unpack "x6CC(x4N)3", $buf;
print "Offsets are $OffsetSize bytes\n";
print "Object Refs are $ObjRefSize bytes\n";
print "There are $NumObjects objects in the file\n";
print "The top object is at $TopObject\n";
print "The Offset Table is at offset $OffsetTableOffset\n\n";
# get the offset table
seek(INF, $OffsetTableOffset, SEEK_SET);
my $rawOffsetTable;
my $readSize = read(INF, $rawOffsetTable, $NumObjects * $OffsetSize);
if ($readSize != $NumObjects * $OffsetSize) {
die "rawOffsetTable read $readSize expected ",$NumObjects * $OffsetSize;
}
@Offsets = unpack(["","C*","n*","(H6)*","N*"]->[$OffsetSize], $rawOffsetTable);
if ($OffsetSize == 3) {
@Offsets = map { hex($_) } @Offsets;
}
$ILen = 0;
$MLen = 0;
$SLen = 0;
my $top = ReadBObjectAt($TopObject);
print "Int Lengths = $ILen\n";
print "Misc Lengths = $MLen\n";
print "String Lengths = $SLen\n";
print "Unique Strings = ",scalar keys %RStrings,"\n";
# write the XML header
print OUTF "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
print OUTF "<!DOCTYPE plist PUBLIC \"-//Apple Computer//DTD PLIST 1.0//EN\" \"http://www.apple.com/DTDs/PropertyList-1.0.dtd\">\n";
print OUTF "<plist version=\"1.0\">\n";
# dump out the top object
WriteTopXML($top);
# write the XML trailer
print OUTF "</plist>\n";
close(OUTF);
close(INF);
}
sub Convert {
print "plutil.pl $VERSION\n\n";
my ($filename) = @ARGV;
if (-s $filename < 8) {
die "$filename is too short for a plist file";
}
# convert binary or text?
open(INF, $filename) or die "can't open $filename";
my $magic;
read(INF, $magic, 8);
close(INF);
if (substr($magic, 0, 6) eq "bplist") { # convert binary plist to XML
if (not ($magic =~ /00$/)) {
warn "Binary plist unknown version: " . substr($magic, -2);
}
ConvertBinaryToXML($filename);
}
else { # convert XML to binary plist
ConvertXMLToBinary($filename);
}
}
if ((@ARGV > 0) && (-e $ARGV[0])) {
Convert($ARGV[0]);
}
else {
print "usage: plutil file[.text|.binary][.plist|.strings|.*]\n";
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment