Detect Pets Body Shop bug/Source Code
From SimsWiki
Overview
This page contains a code in R that finds which clothes were created with the Pets EP Bodyshop with a bug.
Use at your own risk. Any comments please use the Talk:Detect Pets Body Shop bug/Source Code page.
Source
#
# read_package: reads a file (passed by filename)
# and returns a structure
#
library("bitops") # required for bit operations
library("survival") # required for date/time operations
debug.everything <- F
read_package <- function(filename, get.str = F, get.everything = F)
{
# if (debug.everything)
f <- file(filename, open="rb") # open as binary
x <- read_package_header(f) # get the header
if (is.null(x)) {
cat("Error in", filename, "\n")
return(NULL)
}
x$index <- read_package_index_table(f, x) # get index table
x$dir <- read_package_dir(f, x) # get DIR resource (but won't use it)
# set compressed flag whenever index != dir
# but won't use this (and this logic is wrong anyway)
x$compressed <- NULL
imax <- ifelse(x$n.index <= 0, 1, x$n.index)
for (i in 1:imax)
x$compressed[[i]] <- !(same_index(x$index[[i]], x$dir[[i]]))
x$files <- NULL
for (i in 1:imax) {
x$files[[i]] <- NULL
}
# get the property set
x$property.set <- read_package_property_set(f, x)
# if this is a CASThumbnails package, do something with it
x$thumb1 <- read_package_CASThumbnails(f, x)
# get all files (not recommended: this is too slow)
if (get.everything) {
x1 <- x
for (i in 1:imax) {
cat("reading file", i, "\n")
x$files[[i]] <- read_package_file(f, x1, i)
}
}
# get all STR# resources
if (get.str && !get.everything) {
x1 <- x
for (i in 1:imax) {
if (x$index[[i]]$type.id == "53545223") {
x$files[[i]] <- read_package_file(f, x1, i)
}
}
}
# game over
close(f)
return(x)
}
read_package_header <- function(f)
{
x <- NULL # return value
x$dbpf <- readChar(f, 4) # le char[4]
if (x$dbpf != "DBPF") {
cat("Error. Instead of DBPF, I got ", x$dbpf, "\n")
return(NULL)
}
x$major <- readBin(f, "int") # major version
x$minor <- readBin(f, "int") # minor version
unused <- readBin(f, "int", n = 5) # unused
x$index.major <- readBin(f, "int") # major version of index; always 7 in TS2
x$n.index <- readBin(f, "int") # number of entries in the index
x$first.index <- readBin(f, "int") # location of first index entry
x$size.index <- readBin(f, "int") # size of index
x$n.hole <- readBin(f, "int") # number of hole entries in Hole record
x$location.hole <- readBin(f, "int") # location of Hole record
x$size.hole <- readBin(f, "int") # size of Hole record
x$index.minor <- readBin(f, "int") # Minor Version of index + 1
x$index.minor <- x$index.minor - 1
reserved <- readBin(f, "int", n = 8) # 32 bytes (reserved)
return(x)
}
read_package_file <- function(f, x1, i.index)
{
file.index <- x1$index[[i.index]]
seek(f, file.index$location)
f1 <- NULL
# compressed files must have a header
f1$size <- readBin(f, "int") # compressed size of file
n <- file.index$size
if (n <= 0)
return(NULL)
if (n == f1$size) {
if (debug.everything) {
cat("file[", i.index, "] is probably compressed\n")
cat(sprintf("First 4 bytes at offset %08X = %08X\n", file.index$location, n))
}
f1$raw <- read_compressed_file(f, n - 4)
}
else {
seek(f, -4, origin="current")
f1$raw <- readBin(f, "raw", n)
}
f1$human <- convert_raw(f1$raw, file.index$type.id) # convert raw to human-readable format
return(f1)
}
read_package_index_table <- function(f, x1)
{
seek(f, where = x1$first.index)
t <- NULL
imax <- ifelse(x1$n.index <= 0, 1, x1$n.index)
for (i in 1:imax) {
t[[i]] <- read_package_indexlike_entry(f, x1)
}
return(t)
}
read_package_dir <- function(f, x1)
{
# find if any type.id in index is a DIR
i.dir <- 0
imax <- ifelse(x1$n.index <= 0, 1, x1$n.index)
for (i in 1:imax) {
if (x1$index[[i]]$type.id == "E86B1EEF") { # DIR
i.dir <- i
break;
}
}
if (i.dir == 0)
return(NULL)
seek(f, x1$index[[i.dir]]$location)
d <- NULL
for (i in 1:imax) {
d[[i]] <- read_package_indexlike_entry(f, x1, location = x1$index[[i]]$location)
}
return(d)
}
#
# read one block of indexlike entries - used for Index and DIR
#
read_package_indexlike_entry <- function(f, x1, location)
{
t1 <- NULL
r1 <- readBin(f, "int", 4, size=1) # Type ID
if (length(r1) < 4) { # error
return(NULL)
}
r1 <- r1 %% 256
t1$type.id <- sprintf("%02X%02X%02X%02X", r1[4], r1[3], r1[2], r1[1])
t1$group.id <- readBin(f, "raw", 4) # Group ID
t1$instance.id <- readBin(f, "raw", 4) # instance ID
if (x1$index.minor == 1) # version 7.1
t1$second.instance.id <- readBin(f, "raw", 4) # second instance ID
if (missing(location)) # index
t1$location <- readBin(f, "int") # location of the file
else
t1$location <- location # DIR
t1$size <- readBin(f, "int") # size of the file
return(t1)
}
read_package_property_set <- function(f, x1)
{
# find if any type.id in index is a Property Set
i.property.set <- 0
imax <- ifelse(x1$n.index <= 0, 1, x1$n.index)
for (i in 1:imax) {
if (x1$index[[i]]$type.id == "EBCF3E27") { # Property Set
i.property.set <- i
break;
}
}
if (debug.everything)
cat("i.property.set =", i.property.set, "\n")
if (i.property.set == 0)
return(NULL)
f1 <- NULL #
if (is.null(f1)) {
f1 <- read_package_file(f, x1, i.property.set)
return(f1)
}
# compressed files must have a header
cat("These lines are never executed. Why I don't delete them?")
f1$size <- readBin(f, "int") # compressed size of file
f1$qfs <- readBin(f, "raw", 2) # 0x10FB
f1$uncompressed.size <- readBin(f, "int") # 3 bytes or 4 bytes ???
r1 <- readBin(f, "int", 4, size=1) # Type ID
r1 <- r1 %% 256
f1$type.id <- sprintf("%02X%02X%02X%02X", r1[4], r1[3], r1[2], r1[1])
if (f1$type.id != "CBE7505E" && f1$type.id != "CBE750E0")
return (f1)
# CPF
f1$version <- readBin(f, "int", size = 2)
f1$n.items <- readBin(f, "int")
f1$items <- NULL
for (i in 1:(f1$n.items)) {
f2 <- NULL
r1 <- readBin(f, "int", 4, size=1) # Type ID
r1 <- r1 %% 256
f2$data.type <- sprintf("%02X%02X%02X%02X", r1[4], r1[3], r1[2], r1[1])
f2$length <- readBin(f, "int", size=1)
if (debug.everything || f2$length <= 0)
cat("data.type=", f2$data.type, "length =", f2$length, "\n")
f2$name <- readBin(f, "character", f2$length)
if (f2$data.type == "EB61E4F7" || f2$data.type == "0C264712") { # int
f2$data <- readBin(f, "int", f2$length)
}
else if (f2$data.type == "0B8BEA18") { # string
f2$data <- readBin(f, "character", f2$length)
}
else if (f2$data.type == "ABC78708") { # float (4 bytes)
f2$data <- readBin(f, "double", f2$length, size=4)
}
else if (f2$data.type == "CBA908E1") { # boolean (1 byte)
f2$data <- readBin(f, "raw", f2$length)
}
f1$items[[i]] <- f2
}
return(f1)
}
# depois de pegar o Index tem que pegar o DIR resource
# que comeca com ef 1e 6b e8
# CTSS = 53 53 54 43
# XML = 25 e9 a8 cc
# STR# = 23 52 54 53
# Property Set = EBCF3E27
#
read_package_CASThumbnails <- function(f, x1)
{
if (x1$n.index <= 0)
return(NULL)
if (x1$index[[1]]$type.id != "0C7E9A76")
return(NULL)
f1 <- NULL #
if (is.null(f1)) {
f1 <- read_package_file(f, x1, 1)
}
return(f1)
}
#
# Check if the entry from "index" is the same as from "dir"
#
same_index <- function(index, dir)
{
if (is.null(dir))
return(T)
if (is.null(index$type.id) | is.null(dir$type.id) |
is.null(index$group.id)| is.null(dir$group.id) |
is.null(index$instance.id) | is.null(dir$instance.id) |
is.null(index$location) | is.null(dir$location) |
is.null(index$size) | is.null(dir$size))
return(T)
if (index$type.id != dir$type.id)
return(F)
if (any(index$group.id != dir$group.id))
return(F)
if (any(index$instance.id != dir$instance.id))
return(F)
if (index$location != dir$location)
return(F)
if (index$size != dir$size)
return(F)
return(T)
}
#
# read_compressed_file is dmchess's try_decompress
#
read_compressed_file <- function(FH, len, try_decompress = T)
{
if (!try_decompress) {
if (debug.everything || len <= 0)
cat("Reading", len, "bytes as raw\n")
answer <- readBin(FH, "raw", len - 4)
return(answer)
}
header <- readBin(FH, "int", 5, size=1) %% 256 # first five bytes
if (debug.everything)
cat(sprintf("header = %02X %02X %02X %02X %02X\n",
header[1], header[2], header[3], header[4], header[5]));
len <- len - 5
answer <- NULL
answerlen <- 0
byte1 <- byte2 <- byte3 <- 0
# begin of dmchess's try_decompress perl code converted to R
sp <- seek(FH, where=NA) # my $sp = tell FH
while (len > 0) {
if (len %% 1000 == 0) cat(".") # pacifier for very long files
cc <- readBin(FH, "int", 1, size=1) %% 256 # read FH,$buf,1; my $cc = unpack "C", $buf;
len <- len - 1 # $len -= 1;
# printf " Control char is %02x, len remaining is %08x. \n",$cc,$len;
if (cc >= 0xfc) {
numplain <- bitAnd(cc, 0x03) # $numplain = $cc & 0x03;
if (numplain > len) numplain <- len # $numplain = $len if ($numplain > $len);
numcopy <- 0
offset <- 0
}
else if (cc >= 0xe0) {
numplain <- bitShiftL(cc - 0xdf, 2) # $numplain = ($cc - 0xdf) << 2;
numcopy <- 0
offset <- 0
}
else if (cc >= 0xc0) {
len <- len - 3 # $len -= 3;
byte1 <- readBin(FH, "int", 1, size=1) %% 256 # read FH,$buf,1; my $byte1 = unpack "C", $buf;
byte2 <- readBin(FH, "int", 1, size=1) %% 256 # read FH,$buf,1; my $byte2 = unpack "C", $buf;
byte3 <- readBin(FH, "int", 1, size=1) %% 256 # read FH,$buf,1; my $byte3 = unpack "C", $buf;
numplain <- bitAnd(cc, 0x03) # $numplain = $cc & 0x03;
numcopy <- bitShiftL(bitAnd(cc, 0x0c), 6) + 5 + byte3 # $numcopy = (($cc & 0x0c) <<6) + 5 + $byte3;
offset <- bitShiftL(bitAnd(cc, 0x10), 12) + bitShiftL(byte1, 8) + byte2 # ...
# $offset = (($cc & 0x10) << 12 ) + ($byte1 << 8) + $byte2;
}
else if (cc >= 0x80) {
len <- len - 2 # $len -= 2;
byte1 <- readBin(FH, "int", 1, size=1) %% 256 # read FH,$buf,1; my $byte1 = unpack "C", $buf;
byte2 <- readBin(FH, "int", 1, size=1) %% 256 # read FH,$buf,1; my $byte2 = unpack "C", $buf;
numplain <- bitShiftR(bitAnd(byte1, 0xc0), 6) # $numplain = ($byte1 & 0xc0) >> 6;
numcopy <- bitAnd(cc, 0x3f) + 4 # $numcopy = ($cc & 0x3f) + 4;
offset <- bitShiftL(bitAnd(byte1, 0x3f), 8) + byte2 # $offset = (($byte1 & 0x3f) << 8) + $byte2;
}
else {
byte1 <- readBin(FH, "int", 1, size=1) %% 256 # read FH,$buf,1; my $byte1 = unpack "C", $buf;
# cat("byte1 = ", byte1, "\n")
len <- len - 1 # $len -= 1;
numplain <- bitAnd(cc, 0x03) # $numplain = ($cc & 0x03);
numcopy <- bitShiftR(bitAnd(cc, 0x1c), 2) + 3 # $numcopy = (($cc & 0x1c) >> 2) + 3;
offset <- bitShiftL(bitAnd(cc, 0x60), 3) + byte1 # $offset = (($cc & 0x60) << 3) + $byte1;
}
# printf " plain, copy, offset: $numplain, $numcopy, $offset \n";
len <- len - numplain # $len -= $numplain;
if (numplain > 0) { # perl didn't check this
buf <- readBin(FH, "raw", numplain) # read FH,$buf,$numplain;
answer <- c(answer, buf) # $answer = $answer.$buf;
}
fromoffset <- length(answer) - (offset + 1) # my $fromoffset = length($answer) - ($offset + 1); # 0 == last char
if (numcopy > 0)
answer <- c(answer, answer[(fromoffset+1):(fromoffset+numcopy)])
#
# for ($i=0;$i<$numcopy;$i++) {
# $answer = $answer.substr($answer,$fromoffset+$i,1);
# }
answerlen <- answerlen + numplain # $answerlen += $numplain;
answerlen <- answerlen + numcopy # $answerlen += $numcopy;
if (debug.everything) {
cat(" cc=", sprintf("%x", cc), "\n")
cat(" byte1 =", byte1, "byte2 =", byte2, "\n")
cat(" numplain =", numplain, "numcopy =", numcopy,
"offset =" , offset, "fromoffset =", fromoffset, "\n")
}
if (len < 0)
cat(" UNDERFLOW\n") # if ($len<0) { printf " UNDERFLOW \n"; }
}
# printf( " Answer length is %08x (%08x). \n", answerlen, length(answer)) # ...
# printf " Answer length is %08x (%08x). \n",$answerlen,length($answer);
seek(FH, sp) # seek FH,$sp,0;
return(answer) # return $answer;
}
convert_raw <- function(raw, type.id)
{
if (type.id == "EBCF3E27" & all(as.integer(raw[1:4]) == c(0xe0, 0x50, 0xe7, 0xcb)))
return(convert_cpf(raw[-(1:4)]))
if (type.id == "53545223")
return(convert_str(raw))
return(NULL)
}
convert_cpf <- function(raw)
{
if (debug.everything)
cat("converting raw to cpf\n")
cpf <- NULL
cpf$id <- "CPF"
cpf$version <- get_little_endian(raw, 2)
n <- get_little_endian(raw[3:6], 4)
cpf$data <- NULL
pos <- 7
for (i in 1:n) {
xtype <- get_little_endian(raw[pos:(pos+3)], 4)
pos <- pos + 4
nlen <- get_little_endian(raw[pos:(pos+3)], 4) # len of field name
pos <- pos + 4
# the code below is very stupid, but I don't know how to do it in an intelligent way
name <- rawToChar(raw[pos:(pos+nlen-1)])
pos <- pos + nlen
if (xtype == 0xEB61E4F7 || xtype == 0x0C264712 || xtype == 0xABC78708) { # integer or float
data <- get_little_endian(raw[pos:(pos+3)], 4)
pos <- pos + 4
cpf[[name]] <- data
}
else if (xtype == 0x0B8BEA18) { # string
slen <- get_little_endian(raw[pos:(pos+3)], 4)
pos <- pos + 4
str <- rawToChar(raw[pos:(pos+slen-1)])
pos <- pos + slen
cpf[[name]] <- str
}
else if (xtype == 0xCBA908E1) { # boolean
cpf[[name]] <- raw[pos]
pos <- pos + 1
}
}
return(cpf)
}
convert_str <- function(raw)
{
# not ok, but will do for now
return(rawToChar(raw[70:length(raw)]))
}
get_little_endian <- function(bytes, n)
{
# I bet there's a more elegant way to do this
return(sum(256^(0:(n-1)) * as.integer(bytes[1:n])))
}
#
# The next routine opens _all_ package files since
# some date and tests if it was infected by the bug
# in the Pets EP Bodyshop. start_date must be passed
# as an ISO-8601 string.
#
find_pets_ep_bug <- function(start_date = "2006-10-01")
{
# create vector with all filenames that end in .package
s_date <- as.POSIXlt(start_date, "GMT")
fnlist <- list.files(pattern = ".package$")
for (i in 1:length(fnlist)) {
filename <- fnlist[i]
# get modification time of package
m_date <- as.POSIXlt(file.info(filename)$mtime, "GMT")
# skip if package is older than start date
if (m_date < s_date)
next # in C or similar languages, this would be a continue
# now let's do the hard work
x <- try(read_package(filename, get.everything = F))
# there should be some sanity checks here!
if (is.null(x)) {
cat(filename, "seems to have another error\n")
next
}
if (is.null(x$property.set)) next
if (is.null(x$property.set$human)) next
if (is.null(x$property.set$human$type)) next
if (is.null(x$property.set$human$type != "skin")) next
# everything suggests that this is a recolor / outfit / clothing
if (is.null(x$property.set$human$outfit))
cat(filename, "seems to include the Pets EP Bodyshop bug\n")
}
# done
cat("Total of", length(fnlist), "files processed\n")
}
