SECCON 2015 Qualに参加しました。

チームnegainoidoで参加しました。

チームメンバーはautotaker, atetubou, cympfh, garasubo, isurugieri, tailedだった。
atetubouとtailedは台湾旅行(ICPCのアジア地区予選)中だったので遠隔参加でした。

コンテスト開始時

開始直後にatetubouがStart SECCON CTFを通した。

2015-12-05 15:02:16: negainoido: 50 (+50), Start SECCON CTF

SECCON Warsはやることははっきりしていたのでgarasuboに取り組んでもらった。

16時

2015-12-05 15:58:23: negainoido: 150 (+100), Reverse-Engineering Android APK 1

by autotaker

2015-12-05 16:03:40: negainoido: 250 (+100), Command-Line Quiz

by atetubou

2015-12-05 16:21:37: negainoido: 350 (+100), SECCON WARS 2015

by garasubo

コンテストサーバがおもくなりフラグを送信できなかったり、問題が見られなかったりでイライラしていた。

17時

2015-12-05 17:03:16: negainoido: 450 (+100), Connect the server

by tailed, autotaker

2015-12-05 17:45:33: negainoido: 750 (+300), Decrypt it

by atetubou

台湾でICPCの準備中とは思えないatetubouとtailedの仕事の早さに驚かされた。
本戦に行けることになったときに、チーム内で選抜をするという脅しをかけたのが良かったのかもしれない。
atetubouにunzipが既知平文攻撃ではないかと教えてもらい、cympfhが手元でpkcrackを走らせ始めた。

Entry formについてtailed, autotaker, cympfhでいろいろと試す。

18時

2015-12-05 18:39:55: negainoido: 850 (+100), Entry form

by tailed, cympfh, autotaker
Entry formの問題でtailedがブラインドOSインジェクションで/SECRETS/以下を読む。
atetubouとtailedが移動でafkしている間にbackdoor123.phpを発見して解いた。

garasuboが帰宅。

19時

isurugieriがCodeThanksFestivalから帰ってきて参加。
晩御飯を食べる。

20時

2015-12-05 20:00:45: negainoido: 950 (+100), Unzip the file

by cympfh
pkcrackがようやく解読してくれた。長い戦いだった。
atetubou, tailedがホテルに移動し、スカイプ通話ができるようになった。
実装の面倒なQRを分担して片付けることになった。
isurugieriとcympfhがQR(Windows)、実装に定評のあるatetubouがQR(Nonogram)を担当。

22時

2015-12-05 22:00:29: negainoido: 1150 (+200), Find the prime numbers

by autotaker, tailed

2015-12-05 22:06:51: negainoido: 1450 (+300), Exec dmesg

by tailed

2015-12-05 22:45:55: negainoido: 1750 (+300), QR puzzle (Nonogram)

by atetubou
Find the prime numbersは何をしているのかはよくわからなかったが、解くだけなら簡単な素因数分解と離散対数を解くだけだった。なんだったんだろう。

23時

2015-12-05 23:36:37: negainoido: 1850 (+100), Steganography 3

by atetubou, tailed
OCRでバイナリを読んで実行した。floodfillの意味をtailedがエスパーしてくれた。
QR(Windows)のデバッグが楽しそうだった。

24時

2015-12-06 00:25:10: negainoido: 2050 (+200), QR puzzle (Windows)

by cympfh, isurugieri, autotaker

2015-12-06 00:48:04: negainoido: 2150 (+100), Steganography 1

by autotaker

このあと、tailedが途中まで書いてくれたQR(Web)のデバッグをcympfhとautotakerでやった。
バグはなおったが、strong-qr-decoderがうまく動かないため、とりあえず諦めた。

深夜

みんな自宅に帰った。TreeWalkerは解法が見えてしまったので、睡魔と闘いながらautotakerが解析した。

2015-12-06 06:18:30: negainoido: 2350 (+200), FSB: TreeWalker

by autotaker
明らかに時間かけすぎだった。寝るべきだった。

翌朝8時

2015-12-06 08:45:12: negainoido: 2400 (+50), Last Challenge (Thank you for playing)

by atetubou?

2015-12-06 08:47:28: negainoido: 2800 (+400), QR puzzle (Web)

by tailed
台湾勢が残しておいた問題を朝飯前に片付けてくれた。ありがたい。
atetubouとtailedはICPCのコンテストに出かけた。

午前中

2015-12-06 10:24:50: negainoido: 3000 (+200), Fragment2

by autotaker

2015-12-06 11:09:12: negainoido: 3100 (+100), 4042

by autotaker, garasubo, isurugieri, tailed
少し寝たら神託が降りてきてあっさり解けた。神に感謝したい。

コンテスト終了まで

この時点で方針の立っている問題がなくなってしまったので、autotaker, cympfh, garasuboの3人でHardware1を解きに行くことにした。LEDの配置さえわかればなんとかなるかと思っていたが、大量のトランジスタがあることに気づき、自分たちの無力を悟った。

結果

3100pts 26位だった。
f:id:autotaker:20151206172710p:plain
去年は3人で2000点くらいだったのでまあまあよくできたと思う。
日本人チームで9位なので学生枠で決勝に行けそう?

またatetubouとtailed(とflowlight氏)が参加していたICPCの方もなかなか良い結果だったようだ。

Template HaskellでJSONデコーダの導出

概要

最近、CodeRunnerというAIコンテストの予選BでJSONデータをいじる必要が出てきたのでHaskellJSONを読めるようにAesonを触ってみた。さらにTemplateHaskellを用いてレコード型の定義からJSONデコーダを自動導出できるようにしてみた。

背景

予選Bの問題は以下のリンクから閲覧できる。coderunner.jp

問題自体も面白いが、今回興味があるのはAPIで渡されるJSONデータである。
そのJSONは以下のような仕様になっている。

  • power: 現在の攻撃力
  • damage: 今までに与えた合計ダメージ
  • hp: 一番前の敵の体力
  • maxhp: 一番前の敵の初期体力
  • hps: 後ろにいる敵の体力の配列(戦う順に並んでいて最後に戦う敵が一番最後になる)
  • friend: 同じ部屋にいる自分以外のユーザーの配列(id昇順)
    • id: ユーザーID
    • power: そのユーザーの現在の攻撃力
    • damage: そのユーザーの今までに与えた合計ダメージ
  • log: イベントの配列(イベントは情報取得APIを前回リクエストしてから今回リクエストした間に起きたもののみを差分として表示する)
    • id: 攻撃したユーザーのユーザーID
    • enemy: 攻撃された敵のID(一番前の敵を含む残り敵数に等しい)
    • time: ためた時間[ミリ秒表記]
    • hp: 攻撃される前の敵の体力

このような構造はHaskellのレコード型を用いて自然に書くことができる。フィールド名にアンダースコアをつけているのは後でLensを使いたいからだ。

module Info where
data GameInfo = GameInfo { _myPower   :: Int
                         , _myDamage  :: Int
                         , _curHp     :: Int
                         , _maxHp     :: Int
                         , _hps       :: [Int]
                         , _friends   :: [Friend]
                         , _logs      :: [Log] }
                         deriving Show

data Friend = Friend { _friendId     :: String
                     , _friendPower  :: Int
                     , _friendDamage :: Int }
                     deriving Show

data Log = Log { _userId  :: String
               , _enemyId :: Int
               , _time    :: Int
               , _hp      :: Int }
               deriving Show

ここで問題となるのがフィールド名の衝突である。
例えばAPIの仕様では"id"というフィールド名はfriendの配列の中とlogの配列の中の両方で使われている。Haskellでは同じフィールド名を異なるレコード型に用いるためには別のファイルに記述しなければならず面倒である。同じファイルに定義する場合にはプリフィックスをつけるなどして適当に名前を変更しなければならない。

JSONのパーズ

JSONデータのパーズにはAesonというライブラリを使う。
aeson: Fast JSON parsing and encoding | Hackage
ライブラリに

decode :: FromJSON a => ByteString -> Maybe a

という関数があるので、GameInfo, Friend, LogのそれぞれをFromJSONのインスタンスにしてやれば良い。

{-# LANGUAGE OverloadedStrings #-}
import Data.Aeson
import Data.Aeson.Types

instance FromJSON Log where
    parseJSON (Object v) =
        Log <$> v .: "id"
            <*> v .: "enemy"
            <*> v .: "time"
            <*> v .: "hp"
    parseJSON invalid = typeMismatch "Log" invalid

instance FromJSON Friend where
    parseJSON (Object v) =
        Friend <$> v .: "id"
               <*> v .: "power"
               <*> v .: "damage"
    parseJSON invalid = typeMismatch "Friend" invalid

instance FromJSON GameInfo where
    parseJSON (Object v) =
        GameInfo <$> v .: "power"
                 <*> v .: "damage"
                 <*> v .: "hp"
                 <*> v .: "maxhp"
                 <*> v .: "hps"
                 <*> v .: "friend"
                 <*> v .: "log"
    parseJSON invalid = typeMismatch "GameInfo" invalid

簡単だし、typeMismatchとかいう関数を呼べばエラーメッセージもいい感じに出してくれる。
実際にパーズするのはこんな感じでできる。

import qualified Data.ByteString.Lazy as B
import Data.Aeson(eitherDecode)
import Text.Printf

testAeson :: FilePath -> (GameInfo -> IO ()) -> IO ()
testAeson path cont = do
    putStrLn $ "Case: " ++ path
    s <- B.readFile path
    case eitherDecode s of
        Left err -> putStrLn err
        Right info -> cont info

main = testAeson "sample.json" print
$ cat sample.json
{"power":2604996,"damage":40599634,"hp":13879712,"maxhp":39050001,"hps":[10857025,17480761,27899524],"friend":[{"id":"PlayerB","power":1542564,"damage":72452052},{"id":"PlayerC","power":1522756,"damage":52232156}],"log":[{"id":"PlayerC","enemy":4,"time":5017,"hp":39050001},{"id":"PlayerB","enemy":5,"time":5017,"hp":25158831},{"id":"PlayerA","enemy":5,"time":4265,"hp":43349056}]}

$ cat sample-e.json
{"power":2604996,"damage":40599634,"hp":13879712,"maxhp":39050001,"hps":[10857],"friend":[],"log":[0]}

$ ghci InfoTest.hs
GHCi, version 7.10.2: http://www.haskell.org/ghc/  :? for help
[1 of 2] Compiling Info             ( Info.hs, interpreted )
[2 of 2] Compiling Main             ( InfoTest.hs, interpreted )
Ok, modules loaded: Info, Main.
*Main> testAeson "sample.json" print
Case: sample.json
GameInfo {_myPower = 2604996, _myDamage = 40599634, _curHp = 13879712, _maxHp = 39050001, _hps = [10857025,17480761,27899524], _friends = [Friend {_friendId = "PlayerB", _friendPower = 1542564, _friendDamage = 72452052},Friend {_friendId = "PlayerC", _friendPower = 1522756, _friendDamage = 52232156}], _logs = [Log {_userId = "PlayerC", _enemyId = 4, _time = 5017, _hp = 39050001},Log {_userId = "PlayerB", _enemyId = 5, _time = 5017, _hp = 25158831},Log {_userId = "PlayerA", _enemyId = 5, _time = 4265, _hp = 43349056}]}
*Main> testAeson "sample-e.json" print
Case: sample-e.json
Error in $.log[0]: failed to parse field log: expected Log, encountered Number

Template Haskellで自動導出

上のインスタンス宣言はレコード型のフィールド名とJSONオブジェクトのレコード名の対応関係さえ与えてやれば自動導出できそうなのでやってみた。
一応aesonのライブラリ自体にもGenericを用いた自動導出とTemplateHaskellを用いた自動導出があるのだが、それらはHaskellのデータ型をイイ感じのJSONにするのには向いていても、すでにあるJSON型をデコードするのにはあまり向いていないように見えた。

自動導出器はTemplate.hsに実装した。
使い方はこんな感じである。

{-# LANGUAGE TemplateHaskell #-}
module Info where
import Template

data Log = Log { _userId  :: String
               , _enemyId :: Int
               , _time    :: Int
               , _hp      :: Int }
               deriving Show

data Friend = Friend { _friendId     :: String
                     , _friendPower  :: Int
                     , _friendDamage :: Int }
                     deriving Show

data GameInfo = GameInfo { _myPower   :: Int
                         , _myDamage  :: Int
                         , _curHp     :: Int
                         , _maxHp     :: Int
                         , _hps       :: [Int]
                         , _friends   :: [Friend]
                         , _logs      :: [Log] }
                         deriving Show

mkFromJSON ''Log [ ('_userId,  "id")
                 , ('_enemyId, "enemy")
                 , ('_time,    "time")
                 , ('_hp,      "hp") ]

mkFromJSON ''Friend [ ('_friendId,     "id")
                    , ('_friendPower,  "power")
                    , ('_friendDamage, "damage") ]

mkFromJSON ''GameInfo [ ('_myPower,  "power")
                      , ('_myDamage, "damage")
                      , ('_curHp,    "hp")
                      , ('_maxHp,    "maxhp")
                      , ('_hps,      "hps")
                      , ('_friends,  "friend")
                      , ('_logs,     "log") ]

mkFromJSONというマクロがFromJSONのインスタンスを自動導出してくれる。第一引数には導出したい型の名前、第二引数にはフィールド名の対応関係を記したリストを渡せば良い。一応簡単なエラーハンドリングもしているのでフィールド名の漏れ等も検出して教えてくれるようになっている。

Template.hsの実装はこんな感じ。TemplateHaskell触ったのは初めてだったのでチュートリアル等を見ながらなんとなく実装した。QuasiQuote使いつつやればそんなに難しくもなかった。
これらのサイトが参考になった。
できる!Template Haskell (完) - はてな使ったら負けだと思っている deriving Haskell - haskell
Language.Haskell.TH.Syntax

{-# LANGUAGE TemplateHaskell #-}
module Template(mkFromJSON) where
import Language.Haskell.TH
import Data.Aeson
import Data.Aeson.Types
import qualified Data.Text as Text
import Control.Monad

validateInfo :: Name -> [(Name,String)] -> Q Name
validateInfo name fieldmap = do
    info <- reify name
    dec <- case info of
        TyConI dec -> return dec
        _ -> fail $ nameBase name ++ " must be a type constructor"
    cons <- case dec of
        DataD _ _ _ cons _ -> return cons
        _ -> fail $ nameBase name ++ " must be a data type"
    cnstr <- case cons of
        [cnstr] -> return cnstr
        _       -> fail $ nameBase name ++ " must have only one constructor"
    (cname,fields) <- case cnstr of
        RecC cname fields -> return (cname,map (\(x,_,_) -> x) fields)
        _ -> fail $ nameBase name ++ " must be a record type"
    mapM_ (\(field,_) -> unless (field `elem` fields) $
            fail $ "invalid field name" ++ nameBase field)
          fieldmap
    mapM_ (\field -> unless (field `elem` map fst fieldmap) $
            fail $ "corresponding JSON field of the field " ++ nameBase field ++ " is not found")
          fields
    return cname

mkFromJSON :: Name -> [(Name,String)] -> Q [Dec]
mkFromJSON name fieldmap = do
    cnstr <- validateInfo name fieldmap
    vars <- mapM (\y -> (,) y <$> newName "x") fieldmap
    v <- newName "v"
    let invalid = [| typeMismatch $(stringE $ nameBase name) $(varE v) |]
        -- body = do
        --    x1 <- v .: JSONfield1
        --    x2 <- v .: JSONfield2
        --    ...
        --    xn <- v .: JSONfieldn
        --    return $ $cnstr{ field1 = x1, ... fieldn = xn }
        body = doE (stmts ++ ret)
        stmts = [ bindS (varP tvar) [| $(varE v) .: Text.pack $(stringE jsonfield)|] 
                           | ((_,jsonfield),tvar) <- vars ]
        ret = [ noBindS (appE (varE 'return) (recConE cnstr fieldDefs)) ]
        fieldDefs = [ return (field, VarE tvar) | ((field,_),tvar) <- vars ]
    [d| instance FromJSON $(conT name) where
             parseJSON (Object $(varP v)) = $body
             parseJSON $(varP v)          = $invalid |]

終わりに

実装自体は出来たが、これでコードが短くなったかと言われれば微妙だ。
使う側にOverloadedStringsとかの拡張とかライブラリのインポートをしなくても良いのが便利かもしれない。

GADTを用いた型安全なCPS変換の実装

概要

CPS変換とはラムダ項と継続を入力として型Xを持つラムダ項を出力するプログラム変換である。
HaskellのGADTという機能を使うと型Tを持つラムダ項を表すデータ型Term Tを定義できる。
CPS変換が正しいことは
cps :: Term T -> Term ([T] -> X) -> Term Xという型がつくことで表現される。
(ここで[T]は型TをCPS変換した型)

GADTは表現力の高いDSLであるが、parse :: String -> Maybe (Term T)のような関数を書くことはできないため、標準入力からラムダ項を受け取りcps関数に渡すためには少し工夫がいる。

今回はtypeCheck :: Term' -> A -> (forall T. Term T -> A) -> A
という関数を実装することでこの問題を解決した。

実装は以下で公開されている。github.com

とてもとても簡単な解説

CPS変換の実装はSyntax.hsで、パーズした入力をGADTのラムダ項を生成する部分は
TypeCheck.hsにある。詳細は実装を読んでほしい。後日解説を書くかもしれない。

実行例はこんな感じ

$ ./cpstransformer
\(x::o) -> x
Parsed: \(x :: o) -> x
TypeCheck : OK
CPS : (\(x :: o -> (o -> o) -> o) -> end) (\(x :: o) -> \(k :: o -> o) -> k x) 
\(a :: o) -> (\(x :: o -> o) -> x a) (\(b :: o) -> b)
Parsed: \(a :: o) -> (\(x :: o -> o) -> x a) (\(b :: o) -> b)
TypeCheck : OK
CPS : (\(x :: o -> (o -> o) -> o) -> end) (\(a :: o) -> \(k :: o -> o) -> (\(f :: (o -> (o -> o) -> o) -> (o -> o) -> o) -> (\(x :: o -> (o -> o) -> o) -> f x k) (\(b :: o) -> \(k :: o -> o) -> k b)) (\(x :: o -> (o -> o) -> o) -> \(k :: o -> o) -> (\(f :: o -> (o -> o) -> o) -> (\(x :: o) -> f x k) a) x))
\(x :: o -> o) -> x x
Parsed: \(x :: o -> o) -> x x
TypeCheck : failed

参考文献

今回実装したCPS変換は次のサイトを参考にしている。
How to compile with continuations

構文木にIdを振りたい。

構文木に情報を追加したいときにFix使うとちょっと楽だよっていう話。
例えば

data Term = Var String | Lam String Term | App Term Term

みたいなデータの各ノードにIdを振りたいとする。
ナイーブにやると

data ITerm = IVar Int String | ILam Int String ITerm | IApp Int ITerm ITerm

こんな感じになるだろうか。
コンストラクタの名前が変わって冗長だ。

これに対してFixを使うとこうなる。

newtype Fix f = In (f (Fix f))

data TermF a = Var String | Lam String a | App a a
newtype ITermF a = ITermF (Int, TermF a) 
newtype Term = Term (Fix TermF)
newtype ITerm = ITerm (Fix ITermF)

これなら他に型情報とかを追加したくなってもnewtypeで簡単に追加できる。
Idを振るサンプルは以下のとおり。

cata :: Functor f => (f a -> a) -> Fix f -> a
cata f (In t) = f (fmap (cata f) t)

incr :: State Int Int
incr = do
    i <- get
    put $! i + 1
    return i

assignId :: Term -> State Int ITerm
assignId (Term _t) = ITerm <$> cata f _t where
    f (Var s) = c $ pure $ Var s
    f (App t1 t2) = c $ App <$> t1 <*> t2
    f (Lam x t) = c $ Lam x <$> t
    c t = In . ITermF <$> ((,) <$> incr <*> t)

newtype同士のキャストがだいぶ煩雑になってしまうのが玉に瑕だ。

詳細なコードは以下のgistにある。
gist0b9f189fd5cf0550903e

let式の構文解析

導入

以下のBNF*1は足し算とlet式からなる式を表す。

<digit> ::= [0-9]
<alphabet> ::= [a-zA-Z]
<int> ::= <digit> | <digit><int>
<id>  ::= <alphabet> | <id>
<expr> ::= <int> 
        |  <id> 
        |  '(' <expr> ')' 
        |  "let" <id> '=' <expr> "in" <expr>
        |  <expr> '+' <expr>

さて、この文法には2つの曖昧性がある。一つは足し算の結合性、もう一つはlet式と足し算の優先順位の曖昧性だ。

1 + 2 + 3 => 
    (+ (+ 1 2) 3) 
  | (+ 1 (+ 2 3))
let x = 1 in 2 + 3 => 
    (let (x 1) (+ 2 3)) 
  | (+ (let (x 1) 2) 3)

ここでは曖昧性を解決するために足し算は左結合とし、足し算がlet式に優先するとしたい。

そのような文法はPEG*2で以下のように表現できる。

INT <- [0-9]+
ID  <- [a-zA-Z]+
P   <- INT / ID / '(' E ')' / "let" ID '=' E "in" E
E   <- E ('+' P)*

今回の記事ではこのような文法を曖昧性のない文脈自由文法で定義してみる。

最初の試み

自然に考えられる文法として以下のようなものがある。

<prim> ::= <int> | <id> | '(' <expr> ')' 
<term> ::= <prim> | <term> '+' <prim>
<expr> ::= <term> | "let" <id> '=' <expr> "in" <expr>

この文法は上の二つの例を正しくパーズする。

1 + 2 + 3 => (+ (+ 1 2) 3) 
let x = 1 in 2 + 3 => (let (x 1) (+ 2 3))

しかし、この文法は期待する言語を表現していない。例えば次のような式をパーズできない。

1 + let x = 1 in x => Error!

次の試み

上の例からprimがlet式を含まなければならないということがわかった。
しかしprim '+' exprとなっている場合はprimがlet式を含んでいてはならない。
つまり、足し算の第2オペランドにlet式が出現できるかどうかを区別する必要が有る。

<atom> ::= <int> | <id> | '(' <expr> ')'
<prim> ::= <atom> | "let" <id> '=' <expr> "in" <expr>
<term> ::= <atom> | <term> '+' <atom>
<expr> ::= <prim> | <term> '+' <prim>

この文法は期待する言語を表現する。

1 + let x = 1 in x => (+ 1 (let (x 1) x))
1 + let x = 1 in 1 + 2 => (+ 1 (let (x 1) (+ 1 2)))
1 + (let x = 1 in x) + 3 => (+ (+ 1 (let (x 1) x)) 3) 

yaccによる動作確認

この文法に曖昧性がないことを確かめるためにyaccに書き下す。

Parsing

yaccがconflictを出さなかったのでこの文法は曖昧でない。

ちなみに動作例。

$ ocamlbuild main.native
$ ./main.native
1 + let x = 1 in x + x
Plus(1, Let(x, 1, Plus(x, x)))
1 + 2 + 3
Plus(Plus(1, 2), 3)
1 + (2 + 3)
Plus(1, Plus(2, 3))
(let x = 1 in let y = 2 in x + y) + 3
Plus(Let(x, 1, Let(y, 2, Plus(x, y))), 3)

yaccのPrecedenceについて

上のようなパーサはyaccのPrecedenceを適切に設定することによっても得ることができる。

gist114a58bce2ab6af47926

このPrecedenceがどう働くかは
http://dinosaur.compilertools.net/yacc/
に記述がある。

The precedences and associativities are used by Yacc to resolve parsing conflicts; they give rise to disambiguating rules. Formally, the rules work as follows:

1. The precedences and associativities are recorded for those tokens and literals that have them.

2. A precedence and associativity is associated with each grammar rule; it is the precedence and associativity of the last token or literal in the body of the rule. If the %prec construction is used, it overrides this default. Some grammar rules may have no precedence and associativity associated with them.

3. When there is a reduce/reduce conflict, or there is a shift/reduce conflict and either the input symbol or the grammar rule has no precedence and associativity, then the two disambiguating rules given at the beginning of the section are used, and the conflicts are reported.

4. If there is a shift/reduce conflict, and both the grammar rule and the input character have precedence and associativity associated with them, then the conflict is resolved in favor of the action (shift or reduce) associated with the higher precedence. If the precedences are the same, then the associativity is used; left associative implies reduce, right associative implies shift, and nonassociating implies error.

要約すると、各ruleの一番最後に現れるtokenのprecedenceをそのruleのprecedenceとし、パーサを構成する過程でconflictが起こったところでprecedenceの高いruleを選択するという仕組みのようだ。
どうにもad-hocに思えてならないのだが、上手くいく裏付けが何かあるのだろうか。

Haskell組み込みDSLでSVGを書く

概要

プログラムで画像を作りたい時に便利そうなのでメモ。

diagrams-svg: SVG backend for diagrams drawing EDSL. | Hackage
これはHaskellVector画像を描くライブラリである、diagramsライブラリのSVG出力ライブラリとなっている。
diagrams-lib: Embedded domain-specific language for declarative graphics | Hackage

一応githubチュートリアルっぽいものがあるのだが、
それは型エラーでコンパイルできなかった。

今回は使い方を確認するために有名なフラクタル図形を書いてみた。
シェルピンスキーのギャスケット - Wikipedia

コンパイルと実行

$ ghc --make Sierpinski.hs
$ ./Sierpinski -o image.svg 10 5

コマンドライン引数で渡した10と5が図形のパラメータとしてコード中で使用することができて便利だ。

出力される画像はこんな感じになる。
f:id:autotaker:20150226140328p:plain

簡単なコード解説

main :: IO ()
main = mainWith d where
    d c k = pad 1.1 $ sierpinski c k # lcA transparent # fc (sRGB 0.3 0.3 0.3)

mainWithという関数がdの型から適切にコマンドライン引数をパーズしてdに渡してくれる。
関数dはパラメータcとkをつけとって図形を返す。
ここでcとkはそれぞれ最小の三角形のサイズと再帰の深さを表すパラメータで、
ではsierpinski c kという図形の線の色(lcA)や塗りつぶしの色(fc)を指定して、
1割の余白(pad)を付与する。

sierpinski :: Double -> Int -> Diagram B R2
sierpinski c 0 = triangle c 
sierpinski c k = 
    let d' = sierpinski c (k-1)
        l  = c * 2^(k-1) 
        z  = sqrt 3 / 2 * l / 3 
        ps = [(0,z*2),(-l/2,-z),(l/2,-z)] in
    position $ map (\p -> (p2 p,d')) ps

Diagram B R2という型においてBはバックエンドの型(ここではSVG)、R2は2次元画像を意味する。*1
再帰の深さがリミットに達した場合は一辺の長さがcの正三角形(triangle c)を返し、
そうでない場合は、siperpinski図形を生成し(sierpinski c (k-1))、それを3箇所に並べた(position)ものが
siperpinski図形となる。

このようにして図形を代数的にかけるのでとてもイイ感じのライブラリだ。

*1:ちなみにDiagram B R2はMonoidのインスタンスになっているので、複数の図形を書きたい場合はd1 <> d2みたいに すればよい。

ELF解析のはじめ

linuxの実行バイナリであるELFファイルの解析の仕方のメモ

IBMのスライドを参考にした。
http://www-06.ibm.com/jp/linux/tech/doc/attachments/002cb129_elf_v1_0.pdf

サンプルELFの作成

まず、サンプルとなるプログラムを用意する。

// func.c
#include <stdio.h>

int global_num = 0xaa00;

int func1( int i )
{
  return global_num + i;
}

int func2( int i )
{
  return global_num + i + i;
}
//main.c
#include<stdio.h>

extern int global_num;
extern int func1( int i );
extern int func2( int i );

int main( void )
{
  printf( "global_num = %04x\n", global_num );
  printf( "func1( 0x11 ) = %04x\n", func1( 0x11 ) );
  printf( "func2( 0x22 ) = %04x\n", func2( 0x22 ) );
}

gccコンパイルして実行バイナリを作る。

$ gcc -O0 -g -c -o func.o func.c
$ gcc -O0 -g -c -o main.o main.c
$ gcc -o main func.o main.o

解析に入る前に

まず、objdumpを使って逆アセンブルとデータを書き出しておく。

$ objdump -M intel -S main > main.txt
$ objdump -s main > main.data

解析

.textセクションの最初から実行されるということなのでそこを見てみる。

Disassembly of section .text:

08048320 <_start>:
 8048320:	31 ed                	xor    ebp,ebp
 8048322:	5e                   	pop    esi
 8048323:	89 e1                	mov    ecx,esp
 8048325:	83 e4 f0             	and    esp,0xfffffff0
 8048328:	50                   	push   eax
 8048329:	54                   	push   esp
 804832a:	52                   	push   edx
 804832b:	68 10 85 04 08       	push   0x8048510
 8048330:	68 a0 84 04 08       	push   0x80484a0
 8048335:	51                   	push   ecx
 8048336:	56                   	push   esi
 8048337:	68 42 84 04 08       	push   0x8048442
 804833c:	e8 cf ff ff ff       	call   8048310 <__libc_start_main@plt>
 8048341:	f4                   	hlt    
 8048342:	66 90                	xchg   ax,ax
 8048344:	66 90                	xchg   ax,ax
 8048346:	66 90                	xchg   ax,ax
 8048348:	66 90                	xchg   ax,ax
 804834a:	66 90                	xchg   ax,ax
 804834c:	66 90                	xchg   ax,ax
 804834e:	66 90                	xchg   ax,ax

0x8048510, 0x80484a0, 0x8048442というのは
それぞれ__libc_csu_fini, __libc_csu_init, mainの関数ポインタのようだ。

それらを適当にスタックに積んだ後で
__libc_start_main@pltという関数を呼び出している。
__libc_start_main@pltというのはどうなっているかというと、

08048310 <__libc_start_main@plt>:
 8048310:	ff 25 14 a0 04 08    	jmp    DWORD PTR ds:0x804a014
 8048316:	68 10 00 00 00       	push   0x10
 804831b:	e9 c0 ff ff ff       	jmp    80482e0 <_init+0x2c>

0x804a014のポインタ先に間接ジャンプしているらしい。
よくわからないのでIBMのスライドを見てみると、共有ライブラリの関数を呼ぶ場合は
実行時に関数ポインタが書き込まれるとのことだ。

gdbで実行してみる。

$ gdb main
(gdb) b *0x8048510
(gdb) b *0x80484a0
(gdb) b *0x8048442
(gdb) run
Breakpoint 2, 0x080484a0 in __libc_csu_init ()
(gdb) info stack
#0  0x080484a0 in __libc_csu_init ()
#1  0xb7e2d89a in __libc_start_main (main=0x8048442 <main>, argc=1,
      ubp_av=0xbfffebd4, init=0x80484a0, <__libc_csu_init>,
      fini=0x8048510 <__libc_csu_fini>, rtld_fini=0xb7fed5f0 <_dl_fini>,
      stack_end=0xbfffebcc) at libc-start.c:219
#2  0x08048341 in _start ()

__libc_csu_initが呼び出された。この関数が何をやっているのかはよくわからないので
次に進むとmainが呼び出されている。

main部分は簡単に読むことができた。