IPSパッチ

なんかIPSというフォーマットのパッチがあるらしい。
てきとーにググるとWinIPSとかいうソフトが有名らしい。
MacだとIPSPatcherとかが有名らしい。
配布形式がみんなsitなのはなんか理由あるのだろうかとか考えつつ、sitの使い方が分からない。

分からないからググろう。

IPS形式について。

なぜここでsitについて調べずにipsについて調べたかというと、「なんとなく」だ。
まぁ、そんな日もあるさ。

で、IPSについて。

適当に転がってたIPSファイルを、かるくhexdump -Cあたりで読んでみるとPATCHから始まってEOFで終わることが分かる。
ふむ。
間のデータに関してはちと分からない。
分からなければググるのみ。
id:GOCHA氏のhatenaに仕様発見*1。
よく分からなかったのはビッグエンディアンだったからか。
多分最初にアドレスが来るだろうとか思っていたのだが、無意識にリトルエンディアンで読んでたから気がつかなかったらしい。

軽くまとめると

Magic (3 bytes, "PATCH")
Clusters = (
  Address (3 bytes big endian)
  Size (2 bytes big endian)
  Data (size byte/bytes)
|
  Address (3 bytes big endian)
  (Size) (2 bytes, 00 00)
  Size (2bytes big endian)
  Data (1 byte)
)*
EOF (3 bytes, "EOF")

前者は単純なデータの上書き。後者はDataを使ってデータ範囲を同じ値で埋める。らしい。
むぅ。too much simple。

Address = "EOF" = 0x454f46
は正しいアドレスになり得るから、"EOF"を読んだからといってそこで終了にできないという。
まぁ、Size読もうとした段階でファイル終端に達したら、Address == "EOF"かチェックして、一致しなかったら異常終了、ってことになるのかな？
AddressとEOFはともに3 bytesだし。

...EOFの存在意義がよく分からない。最後までちゃんとダウンロードできました、ってか？
ヘッダにクラスタの個数書いたほうが...とか思うのは素人考えなんだろうか。

で、なんか単純そうなのでHaskellで書いてみた。
名前はまんまhsips。

import Prelude ( (*), (+), (-), Char, IO, Int, error )
import Array ( (//), elems, listArray )
import Char ( ord )
import Data.Eq ( (==), Eq )
import Data.Function ( ($), id )
import List ( (++), concat, foldl, length, replicate, splitAt, zip )
import Maybe ( Maybe( Just, Nothing ) )
import Monad ( MonadPlus, guard, mzero, return )
import System ( getArgs, getProgName )
import System.IO ( Handle, IOMode( ReadMode, WriteMode ), hClose, hGetContents, hPutStr, openBinaryFile, putStrLn, stdin, stdout )

main :: IO ()
main = do
	args <- getArgs
	case args of
		[ipsFile] -> do
			hIps <- openBinaryFile ipsFile ReadMode
			patch hIps stdin stdout
			hClose hIps
		[ipsFile, inFile] -> do
			hIps <- openBinaryFile ipsFile ReadMode
			hInput <- openBinaryFile inFile ReadMode
			patch hIps hInput stdout
			hClose hInput
			hClose hIps
		[ipsFile, inFile, outFile] -> do
			hIps <- openBinaryFile ipsFile ReadMode
			hInput <- openBinaryFile inFile ReadMode
			hOutput <- openBinaryFile outFile WriteMode
			patch hIps hInput hOutput
			hClose hOutput
			hClose hInput
			hClose hIps
		_ -> do
			progName <- getProgName
			putStrLn $ "usage: " ++ progName ++ " ips [input] [output]"

unfoldr2 :: (b -> Maybe (a, b)) -> b -> ([a], b)
unfoldr2 f x =
	case f x of
		Just (y, x') -> let (ys,xs) = unfoldr2 f x' in (y:ys,xs)
		Nothing -> ([], x)

patch :: Handle -> Handle -> Handle -> IO ()
patch hIps hInput hOutput = do
	ips <- hGetContents hIps
	input <- hGetContents hInput
	let inputArray = listArray (0, length input - 1) input
	case readIPS ips of
		Just (patches, []) -> hPutStr hOutput $ elems $ inputArray // patches
		_ -> error "IPS format error"

readIPS :: (MonadPlus m) => [Char] -> m ([(Int, Char)], [Char])
readIPS source = do
	(_, x1) <- readMagic source
	(patches, x2) <- return $ unfoldr2 readCluster x1
	(_, x3) <- readEOF x2
	return (concat patches, x3)

readCluster :: (MonadPlus m) => [Char] -> m ([(Int, Char)], [Char])
readCluster source = do
		(a, x1) <- readAddr source
		(s, x2) <- readSize x1
		if s == 0
			then do
				(s2, x3) <- readSize x2
				(d, x4) <- readData 1 x3
				let patches = zip [a..] $ concat $ replicate s2 d
				return $ (patches, x4)
			else do
				(d, x3) <- readData s x2
				let patches = zip [a..] $ d
				return $ (patches, x3)

readMagic :: (MonadPlus m) => [Char] -> m ((), [Char])
readMagic source = do
	(x,rest) <- readData 5 source
	guard (x == "PATCH")
	return ((), rest)

readEOF :: (MonadPlus m) => [Char] -> m ((), [Char])
readEOF source = do
	(x,rest) <- readData 3 source
	guard (x == "EOF")
	return ((), rest)

readAddr :: (MonadPlus m) => [Char] -> m (Int, [Char])
readAddr = fetchData readBigendian 3

readSize :: (MonadPlus m) => [Char] -> m (Int, [Char])
readSize = fetchData readBigendian 2

readData :: (MonadPlus m) => Int -> [Char] -> m ([Char], [Char])
readData = fetchData id

fetchData :: (MonadPlus m) => ([Char] -> a) -> Int -> [Char] -> m (a, [Char])
fetchData f n xxs =
	if n == length x
		then return (f x, xs)
		else mzero
	where
		(x,xs) = splitAt n xxs

readBigendian :: [Char] -> Int
readBigendian = foldl (\x y -> x * 0x100 + ord y) 0

とりあえずdoを使いたかったです、的な実装です。
いや、Maybe Monadを使いたかったんですよ。はい。
そんなわけで、最初read*系は"String -> Maybe (a, String)"型にしてて Maybe a"だった。Address == "EOF"問題に気がついて『残り』も返すようにした。">*2、途中でこれもっと一般化できるかも、とか思って"(MonadPlus m) => "に変えてみたのだが...。

見れば見るほどReadS [(a, String)]"。リスト([])もMonadかつMonadPlus。">*3です。本当にありがとうございました。
よくよく考えればやってることはパースだし、最初からReadSでやればよかったとかね...。
まぁ、動いてるのでよしとします。

実装自体はなんども手直ししたのでそこそこきれいになった気がする。と自画自賛。
doでMaybe Monadを使いまくってるので、ぱっとみカオス。

と、いうことで、なんとなくIPSパッチャー作ってみたけど...、そういやなんでIPSパッチャー必要だったんだっけ？
とかいうオチ。

*1:http://d.hatena.ne.jp/GOCHA/20060206/ips

*2:もっと正確に『最初』に書いたのは"String -> Maybe a"だった。Address == "EOF"問題に気がついて『残り』も返すようにした。

*3:ReadS = "String -> [(a, String)]"。リスト([])もMonadかつMonadPlus。