diff --git a/peyotls.cabal b/peyotls.cabal --- a/peyotls.cabal +++ b/peyotls.cabal @@ -2,7 +2,7 @@ cabal-version: >= 1.8 name: peyotls -version: 0.1.6.0 +version: 0.1.6.1 stability: Experimental author: Yoshikuni Jujo maintainer: Yoshikuni Jujo @@ -281,7 +281,7 @@ source-repository this type: git location: git://github.com/YoshikuniJujo/peyotls.git - tag: peyotls-0.1.6.0 + tag: peyotls-0.1.6.1 library hs-source-dirs: src diff --git a/src/Network/PeyoTLS/TChan/Server.hs b/src/Network/PeyoTLS/TChan/Server.hs --- a/src/Network/PeyoTLS/TChan/Server.hs +++ b/src/Network/PeyoTLS/TChan/Server.hs @@ -42,6 +42,8 @@ rmk = kRMKey k wk = kWKey k wmk = kWMKey k + CipherSuite _ rcs = kRCSuite k + CipherSuite _ wcs = kWCSuite k _ <- liftBaseDiscard forkIO . (`evalStateT` 1) . forever $ do sn <- get @@ -51,15 +53,27 @@ lift (hlClose h) >> error "bad" Right n <- B.decode <$> lift (hlGet h 2) renc <- lift $ hlGet h n - let Right rpln = decrypt sha1 rk rmk sn pre renc + let hs = case rcs of + AES_128_CBC_SHA -> sha1 + AES_128_CBC_SHA256 -> sha256 + _ -> error "Network.PeyoTLS.TChan.Server.open: bad" + rpln = case decrypt hs rk rmk sn pre renc of + Right r -> r + Left l -> error $ + "Network.PeyoTLS.TChan.Server.open: " + ++ show l liftBase . atomically $ writeTChan inc rpln _ <- liftBaseDiscard forkIO . (`evalStateT` (1, g')) . forever $ do (sn, g0) <- get wpln <- liftBase . atomically $ readTChan otc - let (wenc, g1) = - encrypt sha1 wk wmk sn "\ETB\ETX\ETX" wpln g0 + let hs = case wcs of + AES_128_CBC_SHA -> sha1 + AES_128_CBC_SHA256 -> sha256 + _ -> error "Network.PeyoTLS.TChan.Server.open: bad" + (wenc, g1) = + encrypt hs wk wmk sn "\ETB\ETX\ETX" wpln g0 put (succ sn, g1) lift $ hlPut h "\ETB\ETX\ETX" lift . hlPut h