mirror of
https://github.com/captn3m0/Scripts.git
synced 2024-09-28 16:22:49 +00:00
1078 lines
24 KiB
Perl
1078 lines
24 KiB
Perl
|
# 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/</</g;
|
||
|
$s =~ s/>/>/g;
|
||
|
$s =~ s/&/&/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/&/&/g;
|
||
|
$in =~ s/</</g;
|
||
|
$in =~ s/>/>/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/&/&/g;
|
||
|
$oVal =~ s/</</g;
|
||
|
$oVal =~ s/>/>/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";
|
||
|
}
|