├── src ├── Demo │ ├── Querschlaeger.hs │ ├── Server.hs │ └── Client.hs └── Network │ ├── Ricochet.hs │ └── Ricochet │ ├── Protocol │ ├── proto │ │ ├── ChatChannel.proto │ │ ├── AuthHiddenService.proto │ │ ├── ContactRequestChannel.proto │ │ └── ControlChannel.proto │ ├── Protobuf.hs │ ├── Protobuf │ │ ├── ContactRequest.hs │ │ ├── Chat.hs │ │ ├── AuthHiddenService.hs │ │ └── ControlChannel.hs │ └── Lowest.hs │ ├── Util.hs │ ├── Version.hs │ ├── Crypto.hs │ ├── Types.hs │ ├── Connection.hs │ ├── Crypto │ └── RSA.hsc │ └── Monad.hs ├── .gitignore ├── default.nix ├── test ├── Network │ └── Ricochet │ │ └── Testing │ │ ├── Instances.hs │ │ └── Crypto.hs └── Main.hs ├── Setup.hs ├── Readme.adoc ├── torrc ├── CONTRIBUTING.adoc ├── haskell-ricochet.cabal └── LICENSE /src/Demo/Querschlaeger.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | main :: IO () 4 | main = do 5 | 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # nix 2 | result/ 3 | haskell-ricochet.nix 4 | # haskell 5 | dist/ 6 | cabal-dev 7 | *.o 8 | *.hi 9 | *.chi 10 | *.chs.h 11 | *.dyn_o 12 | *.dyn_hi 13 | .hpc 14 | .hsenv 15 | .cabal-sandbox/ 16 | cabal.sandbox.config 17 | *.prof 18 | *.aux 19 | *.hp 20 | .stack-work/ 21 | # Generated by hprotoc, see Setup.hs 22 | src/Network/Ricochet/Protocol/Data/ 23 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | let nixpkgs = import {}; 2 | old = import (nixpkgs.fetchFromGitHub { 3 | owner = "NixOS"; 4 | repo = "nixpkgs"; 5 | rev = "39b48ed2effa2bf2c4241869ec78d5bcbaac5a3d"; 6 | sha256 = "1592sszn3f98v3pllbfcy5ad558ynj447pqm4hvb5kj766nfm69k"; 7 | }) {}; 8 | in old.haskellPackages.callPackage ./haskell-ricochet.nix {} 9 | -------------------------------------------------------------------------------- /src/Network/Ricochet.hs: -------------------------------------------------------------------------------- 1 | module Network.Ricochet where 2 | 3 | import Network.Ricochet.Connection 4 | import Network.Ricochet.Monad 5 | import Network.Ricochet.Protocol.Lowest 6 | import Network.Ricochet.Protocol.Protobuf 7 | import Network.Ricochet.Protocol.Protobuf.AuthHiddenService 8 | import Network.Ricochet.Protocol.Protobuf.ControlChannel 9 | import Network.Ricochet.Types 10 | import Network.Ricochet.Util 11 | import Network.Ricochet.Version 12 | -------------------------------------------------------------------------------- /test/Network/Ricochet/Testing/Instances.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Network.Ricochet.Testing.Instances 3 | Description : Instances needed for testing 4 | 5 | "Network.Ricochet.Testing.Instances" contains all of the instances needed for 6 | proper testing. This will be mainly QuickCheck's Arbirtrary. 7 | -} 8 | 9 | module Network.Ricochet.Testing.Instances where 10 | 11 | import Test.QuickCheck 12 | import Data.ByteString 13 | 14 | instance Arbitrary ByteString where 15 | arbitrary = pack <$> vectorOf 30 arbitrary 16 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Protocol/proto/ChatChannel.proto: -------------------------------------------------------------------------------- 1 | package Protocol.Data.Chat; 2 | 3 | message Packet { 4 | optional ChatMessage chat_message = 1; 5 | optional ChatAcknowledge chat_acknowledge = 2; 6 | } 7 | 8 | message ChatMessage { 9 | required string message_text = 1; 10 | optional uint32 message_id = 2; // Random ID for ack 11 | optional int64 time_delta = 3; // Delta in seconds between now and when message was written 12 | } 13 | 14 | message ChatAcknowledge { 15 | optional uint32 message_id = 1; 16 | optional bool accepted = 2 [default = true]; 17 | } 18 | 19 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Protocol/proto/AuthHiddenService.proto: -------------------------------------------------------------------------------- 1 | package Protocol.Data.AuthHiddenService; 2 | import "ControlChannel.proto"; 3 | 4 | extend Protocol.Data.Control.OpenChannel { 5 | optional bytes client_cookie = 7200; // 16 random bytes 6 | } 7 | 8 | extend Protocol.Data.Control.ChannelResult { 9 | optional bytes server_cookie = 7200; // 16 random bytes 10 | } 11 | 12 | message Packet { 13 | optional Proof proof = 1; 14 | optional Result result = 2; 15 | } 16 | 17 | message Proof { 18 | optional bytes public_key = 1; // DER encoded public key 19 | optional bytes signature = 2; // RSA signature 20 | } 21 | 22 | message Result { 23 | required bool accepted = 1; 24 | optional bool is_known_contact = 2; 25 | } 26 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Protocol/proto/ContactRequestChannel.proto: -------------------------------------------------------------------------------- 1 | package Protocol.Data.ContactRequest; 2 | import "ControlChannel.proto"; 3 | 4 | enum Limits { 5 | MessageMaxCharacters = 2000; 6 | NicknameMaxCharacters = 30; 7 | } 8 | 9 | extend Protocol.Data.Control.OpenChannel { 10 | optional ContactRequest contact_request = 200; 11 | } 12 | 13 | extend Protocol.Data.Control.ChannelResult { 14 | optional Response response = 201; 15 | } 16 | 17 | // Sent only as an attachment to OpenChannel 18 | message ContactRequest { 19 | optional string nickname = 1; 20 | optional string message_text = 2; 21 | } 22 | 23 | // Response is the only valid message to send on the channel 24 | message Response { 25 | enum Status { 26 | Undefined = 0; // Not valid on the wire 27 | Pending = 1; 28 | Accepted = 2; 29 | Rejected = 3; 30 | Error = 4; 31 | } 32 | 33 | required Status status = 1; 34 | } 35 | 36 | -------------------------------------------------------------------------------- /src/Demo/Server.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Network.Ricochet 6 | import Network.Ricochet.Connection 7 | import Network.Ricochet.Monad 8 | import Network.Ricochet.Types 9 | 10 | import Control.Concurrent (threadDelay) 11 | import Control.Lens 12 | import Control.Monad.State 13 | import Data.ByteString (ByteString (), pack) 14 | import qualified Data.Map as M 15 | import Data.Monoid ((<>)) 16 | import Network hiding (accept, connectTo) 17 | 18 | 19 | config = RicochetConfig 9878 Nothing 9051 9050 [(1, handler)] 20 | 21 | main = 22 | startRicochet config [] $ do 23 | addr <- use hiddenDomain 24 | liftIO . print $ addr 25 | void awaitConnection 26 | 27 | handler con = 28 | forever $ do 29 | p <- nextPacket con 30 | liftIO $ print p 31 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Main 3 | Description : The executable to run all of the tests 4 | 5 | "Main" is the top-level testing module describing the executable running all of 6 | the tests for the project. 7 | -} 8 | 9 | module Main where 10 | 11 | import Test.Tasty 12 | import qualified Test.Tasty.QuickCheck as QC 13 | import qualified Test.Tasty.HUnit as HU 14 | 15 | import Network.Ricochet.Testing.Instances 16 | import Network.Ricochet.Testing.Crypto 17 | --import Network.Ricochet.Testing.General 18 | 19 | main = defaultMain tests 20 | 21 | tests = testGroup "Network.Ricochet.Testing" [ cryptoTests ] 22 | 23 | cryptoTests = testGroup "Network.Ricochet.Testing.Crypto" [ 24 | QC.testProperty "base64check: en- and decoding works" base64Check 25 | , QC.testProperty "signCheck: signing and verifying works" signCheck 26 | , QC.testProperty "rawSignCheck: raw signing and verifying works" rawSignCheck 27 | , HU.testCase 28 | "torDomainAssertion: hidden service domains are computed correctly" 29 | torDomainAssertion 30 | ] 31 | 32 | generalTests = testGroup "Network.Ricochet.Testing.General" [ 33 | ] 34 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | import Control.Applicative ((<$>)) 4 | import Control.Monad (liftM2) 5 | import Control.Monad.Reader (ReaderT(..)) 6 | import Data.Function (on) 7 | import Data.Monoid ((<>)) 8 | import System.Process (callProcess) 9 | 10 | runHprotoc = callProcess "hprotoc" 11 | [ "--haskell_out=src" 12 | , "--proto_path=src/Network/Ricochet/Protocol/proto" 13 | , "--prefix=Network.Ricochet" 14 | , "--lenses" 15 | , "AuthHiddenService.proto" 16 | , "ChatChannel.proto" 17 | , "ContactRequestChannel.proto" 18 | , "ControlChannel.proto" 19 | ] 20 | 21 | preConfHook = preConf simpleUserHooks `combine` const (const (runHprotoc >> return mempty)) 22 | main = defaultMainWithHooks $ simpleUserHooks { preConf = preConfHook } 23 | 24 | combine' :: (Monad m, Monoid b) => (a -> m b) -> (a -> m b) -> (a -> m b) 25 | combine' = (fmap runReaderT . liftM2 (<>)) `on` ReaderT 26 | 27 | combine :: (Monad m, Monoid c) => (a -> b -> m c) -> (a -> b -> m c) -> a -> b -> m c 28 | combine = fmap curry <$> combine' `on` uncurry 29 | -------------------------------------------------------------------------------- /src/Demo/Client.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Network.Ricochet 6 | import Network.Ricochet.Connection 7 | import Network.Ricochet.Monad 8 | import Network.Ricochet.Types 9 | 10 | import Control.Concurrent (threadDelay) 11 | import Control.Lens 12 | import Control.Monad (when, void) 13 | import Control.Monad.State 14 | import Data.ByteString (ByteString (), pack) 15 | import qualified Data.Map as M 16 | import Network hiding (accept, connectTo) 17 | import System.Environment (getArgs) 18 | 19 | config = RicochetConfig 9879 Nothing 9051 9050 [(1, handler)] 20 | 21 | main = do 22 | args <- getArgs 23 | when (length args /= 1) $ error "Usage: client " 24 | startRicochet config [] $ do 25 | addr <- use hiddenDomain 26 | liftIO . print $ addr 27 | con <- connectTo (head args) (PortNumber 9878) 28 | liftIO . putStrLn $ "Connected!" 29 | nextPacket con >>= liftIO . print 30 | 31 | handler con = 32 | forever $ do 33 | p <- nextPacket con 34 | liftIO . print $ p 35 | -------------------------------------------------------------------------------- /Readme.adoc: -------------------------------------------------------------------------------- 1 | haskell-ricochet 2 | ================ 3 | shak-mar, brotknust, Bez, sternenseemann, hackalive, Hanfi10 4 | :toc: 5 | :showtitle: 6 | 7 | A wip Haskell library for http://ricochet.im[ricochet.im]. 8 | 9 | == Idea 10 | 11 | We really like Ricochet but the application is a monolithic Qt-based one. 12 | 13 | We are developing this library for those reasons: 14 | 15 | * Different frontends – like ncurses 16 | * Possibility to build bots 17 | * Easier to extend the protocol using new channel types (adding these is meant to be easy using our library) 18 | 19 | == Stability and Security 20 | 21 | Don't use this project unless you are developing on it. It is probably neither stable nor secure and far from being finished. 22 | 23 | == Building and Documentation 24 | 25 | We tested everything using the following nix-workflow but you should also get it to work using stack or cabal. 26 | 27 | [source,shell] 28 | ---- 29 | cabal2nix . > haskell-ricochet.nix 30 | nix-shell -A env # for dependencies 31 | cabal configure 32 | cabal build 33 | cabal haddock # documentation 34 | cabal repl # for playing around 35 | cabal test # tests (need tor running with control port open) 36 | ---- 37 | 38 | == Get in touch! 39 | 40 | * …with the https://github.com/ricochet-im/ricochet#other[original ricochet-developers] 41 | * …with us: `#ricochet` on Freenode 42 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Util.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Network.Ricochet.Util 3 | Description: A collection of utility functions 4 | 5 | "Network.Ricochet.Util" contains a collection of utility functions used 6 | throughout the package. 7 | -} 8 | 9 | {-# LANGUAGE RankNTypes #-} 10 | 11 | module Network.Ricochet.Util 12 | ( parserResult 13 | , anyWord16 14 | , joinWord8s 15 | , look 16 | , lookWith 17 | ) where 18 | 19 | import Network.Ricochet.Types (ParserResult(..)) 20 | 21 | import Control.Lens(Traversal', (^?), filtered, traversed) 22 | import Control.Monad (liftM2) 23 | import Data.Attoparsec.ByteString (Parser, Result(..), IResult(..), anyWord8) 24 | import Data.Bits (shiftL) 25 | import Data.ByteString (ByteString ()) 26 | import Data.Word (Word8, Word16) 27 | 28 | -- | Joins two Word8s into a single Word16 29 | joinWord8s :: Word8 -> Word8 -> Word16 30 | joinWord8s a b = (fromIntegral a `shiftL` 8) + fromIntegral b 31 | 32 | -- | Parses two bytes into a Word16 33 | anyWord16 :: Parser Word16 34 | anyWord16 = liftM2 joinWord8s anyWord8 anyWord8 35 | 36 | -- | Takes an attoparsec result and converts it 37 | -- into a our representation. 38 | parserResult :: Result r -> ParserResult r 39 | parserResult (Done i r) = Success r i 40 | parserResult (Partial _) = Unfinished 41 | parserResult _ = Failure 42 | 43 | -- | Lookup an item in a list 44 | look :: (Eq a) => a -> Traversal' [a] a 45 | look x = traversed . filtered (== x) 46 | 47 | -- | Lookup an item in a list, extracting an identifier using the given 48 | -- Traversal before comparison 49 | lookWith :: (Eq b) => Traversal' a b -> b -> Traversal' [a] a 50 | lookWith t x = traversed . filtered ((== Just x) . (^? t)) 51 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Protocol/proto/ControlChannel.proto: -------------------------------------------------------------------------------- 1 | package Protocol.Data.Control; 2 | 3 | message Packet { 4 | // Must contain exactly one field 5 | optional OpenChannel open_channel = 1; 6 | optional ChannelResult channel_result = 2; 7 | optional KeepAlive keep_alive = 3; 8 | optional EnableFeatures enable_features = 4; 9 | optional FeaturesEnabled features_enabled = 5; 10 | } 11 | 12 | message OpenChannel { 13 | required int32 channel_identifier = 1; // Arbitrary unique identifier for this channel instance 14 | required string channel_type = 2; // String identifying channel type; e.g. im.ricochet.chat 15 | 16 | // It is valid to extend the OpenChannel message to add fields specific 17 | // to the requested channel_type. 18 | extensions 100 to max; 19 | } 20 | 21 | message ChannelResult { 22 | required int32 channel_identifier = 1; // Matching the value from OpenChannel 23 | required bool opened = 2; // If the channel is now open 24 | 25 | enum CommonError { 26 | GenericError = 0; 27 | UnknownTypeError = 1; 28 | UnauthorizedError = 2; 29 | BadUsageError = 3; 30 | FailedError = 4; 31 | } 32 | 33 | optional CommonError common_error = 3; 34 | 35 | // As with OpenChannel, it is valid to extend this message with fields specific 36 | // to the channel type. 37 | extensions 100 to max; 38 | } 39 | 40 | message KeepAlive { 41 | required bool response_requested = 1; 42 | } 43 | 44 | message EnableFeatures { 45 | repeated string feature = 1; 46 | extensions 100 to max; 47 | } 48 | 49 | message FeaturesEnabled { 50 | repeated string feature = 1; 51 | extensions 100 to max; 52 | } 53 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Protocol/Protobuf.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Network.Ricochet.Protocol.Protobuf 3 | Description: Helper lenses for dealing with Protobuf messages 4 | 5 | "Network.Ricochet.Protocol.Protobuf" defines lenses that enable you to interact 6 | with 'Text.ProtocolBuffers' messages. It’s not specific to this library. 7 | -} 8 | 9 | {-# LANGUAGE RankNTypes #-} 10 | module Network.Ricochet.Protocol.Protobuf 11 | ( ext 12 | , msg 13 | , utf8' 14 | , i32 15 | , d 16 | ) where 17 | 18 | import Control.Lens (Iso', Prism', Traversal', (^?), _1, _Just, _Right, iso, 19 | lazy, lens, prism', strict, to) 20 | import Control.Monad (MonadPlus, mzero) 21 | import Data.ByteString (ByteString) 22 | import Data.Text (Text) 23 | import Data.Text.Encoding (decodeUtf8', encodeUtf8) 24 | import Data.Word (Word16) 25 | import Data.Int (Int32) 26 | import Text.ProtocolBuffers (Default, ExtKey, Key, ReflectDescriptor, Utf8(..), 27 | Wire, defaultValue, utf8, getExt, messageGet, 28 | messagePut, putExt) 29 | 30 | -- | Take an extension key and return a Traversal' that yields all the values to 31 | -- that extension key 32 | ext :: (MonadPlus c, ExtKey c) => Key c msg v -> Traversal' msg (c v) 33 | ext k = lens (^? to (getExt k) . _Right) (flip $ putExt k . maybe mzero id) . _Just 34 | 35 | -- | A Prism' that can dump and parse Protobuf messages 36 | msg :: (ReflectDescriptor msg, Wire msg) => Prism' ByteString msg 37 | msg = lazy . prism' messagePut (^? to messageGet . _Right . _1) 38 | 39 | -- | A Prism that can encode and decode 'Utf8' from and to 'Text'. 40 | utf8' :: Prism' Utf8 Text 41 | utf8' = iso utf8 Utf8 . strict . prism' encodeUtf8 (^? to decodeUtf8' . _Right) 42 | 43 | -- | Isomorphism between Word16 and Int32 44 | i32 :: Iso' Word16 Int32 45 | i32 = iso fromIntegral fromIntegral 46 | 47 | -- | Shortcut for creating protobuf messages and filling them using lenses 48 | d :: Default a => a 49 | d = defaultValue 50 | -------------------------------------------------------------------------------- /test/Network/Ricochet/Testing/Crypto.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Network.Ricochet.Testing.Crypto 3 | Description : The tests for Network.Ricochet.Crypto 4 | 5 | "Network.Ricochet.Testing.Crypto" contains all of the tests for 6 | "Network.Ricochet.Crypto". 7 | -} 8 | 9 | module Network.Ricochet.Testing.Crypto where 10 | 11 | import Network.Ricochet 12 | import Network.Ricochet.Monad 13 | import Network.Ricochet.Crypto 14 | import Test.QuickCheck 15 | import Test.QuickCheck.Monadic 16 | import Test.HUnit hiding (assert) 17 | import Data.Maybe 18 | import Data.ByteString 19 | import Control.Lens 20 | import Control.Monad 21 | import Control.Monad.IO.Class 22 | import Control.Concurrent.MVar 23 | import Network 24 | import OpenSSL.EVP.Verify hiding (verify) 25 | 26 | -- | Check the base64 Prism 27 | base64Check :: ByteString -> Bool 28 | base64Check bs = let tested = bs ^? re base64 . base64 29 | in fromJust tested == bs 30 | 31 | -- | Check the sign and verify functions 32 | signCheck :: ByteString -> ByteString -> Property 33 | signCheck bs bs' = monadicIO $ do 34 | key <- run generate1024BitRSA 35 | let signature = sign key bs 36 | assert . verify key bs $ signature 37 | assert . not . verify key bs' $ signature 38 | 39 | -- | Check the raw sign and verify functions 40 | rawSignCheck :: ByteString -> ByteString -> Property 41 | rawSignCheck bs bs' = monadicIO $ do 42 | key <- run generate1024BitRSA 43 | let signature = rawRSASign key bs 44 | assert . rawRSAVerify key bs $ signature 45 | assert . not . rawRSAVerify key bs' $ signature 46 | 47 | -- | Assert that torDomain computes the correct domain 48 | torDomainAssertion :: Assertion 49 | torDomainAssertion = do 50 | key <- generate1024BitRSA 51 | mVar <- newEmptyMVar 52 | let privKey = base64 . privateDER # key 53 | config = RicochetConfig 54 | { rcPort = PortNumber 9879 55 | , rcPrivKey = Just privKey 56 | , rcControlPort = PortNumber 9051 57 | , rcSocksPort = PortNumber 9050 58 | , rcHandlers = [] 59 | } 60 | startRicochet config [] (use hiddenDomain >>= liftIO . putMVar mVar) 61 | domain <- readMVar mVar 62 | assertEqual "" domain $ torDomain key 63 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Version.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Network.Ricochet.Version 3 | Description: Implementation of the parser and dumper for 'Version's 4 | 5 | "Network.Ricochet.Version" contains the implementations of the parser and dumper 6 | for the version negotiation step of the protocol, as well as some related type 7 | definitions. 8 | -} 9 | 10 | {-# LANGUAGE OverloadedStrings #-} 11 | 12 | module Network.Ricochet.Version 13 | ( Versions () 14 | , Version () 15 | , ConnectionHandler () 16 | , parseIntroduction 17 | , dumpIntroduction 18 | ) where 19 | 20 | 21 | import Network.Ricochet.Util (parserResult) 22 | import Network.Ricochet.Monad (Ricochet) 23 | import Network.Ricochet.Types (Connection, ParserResult) 24 | 25 | import Prelude hiding (lookup) 26 | import Control.Applicative ((<|>)) 27 | import Data.Attoparsec.ByteString (Parser, anyWord8, count, parse, string) 28 | import Data.ByteString (ByteString ()) 29 | import qualified Data.ByteString as B 30 | import Data.List (elem) 31 | import Data.Map (Map (), filterWithKey, keys, lookup, size) 32 | import Data.Maybe (fromJust) 33 | import Data.Monoid ((<>)) 34 | import Data.Word (Word8 ()) 35 | 36 | -- | A Version is a Word8 as defined by the ricochet protocol 37 | type Version = Word8 38 | 39 | -- | Handles a connection between two peers 40 | type ConnectionHandler = Connection -> Ricochet () 41 | 42 | -- | Each version (Word8) has its own Handler that takes a Connection which has 43 | -- completed version negotiation and does Ricochet actions 44 | type Versions = Map Version ConnectionHandler 45 | 46 | -- | Parses Introduction and Version Negotiation of the protocol 47 | parseIntroduction :: Versions -> ByteString -> ParserResult Versions 48 | parseIntroduction vers bs = parserResult . parse (introductionParser vers) $ bs 49 | 50 | -- | Creates a Parser for the introduction step of the protocol 51 | introductionParser :: Versions -> Parser (Map Version ConnectionHandler) 52 | introductionParser supportedVersions = do 53 | string "IM" 54 | nVersions <- anyWord8 55 | versions <- count (fromIntegral nVersions) anyWord8 56 | -- Only return versions supported by this side of the connection 57 | return $ filterWithKey (\k _ -> k `elem` versions) supportedVersions 58 | 59 | -- | Dumps the introduction message 60 | dumpIntroduction :: Versions -> ByteString 61 | dumpIntroduction supportedVersions = "IM" <> versionCount <> versions 62 | where versionCount = B.singleton (fromIntegral . size $ supportedVersions) 63 | versions = foldl (\s c -> s <> B.singleton c) "" 64 | (keys supportedVersions) 65 | -------------------------------------------------------------------------------- /torrc: -------------------------------------------------------------------------------- 1 | ## Configuration file for a typical Tor user 2 | ## Last updated 22 April 2012 for Tor 0.2.3.14-alpha. 3 | ## (may or may not work for much older or much newer versions of Tor.) 4 | ## 5 | ## Lines that begin with "## " try to explain what's going on. Lines 6 | ## that begin with just "#" are disabled commands: you can enable them 7 | ## by removing the "#" symbol. 8 | ## 9 | ## See 'man tor', or https://www.torproject.org/docs/tor-manual.html, 10 | ## for more options you can use in this file. 11 | ## 12 | ## Tor will look for this file in various places based on your platform: 13 | ## https://www.torproject.org/docs/faq#torrc 14 | 15 | ## Tor opens a socks proxy on port 9050 by default -- even if you don't 16 | ## configure one below. Set "SocksPort 0" if you plan to run Tor only 17 | ## as a relay, and not make any local application connections yourself. 18 | SocksPort 9050 # Default: Bind to localhost:9050 for local connections. 19 | 20 | ## Entry policies to allow/deny SOCKS requests based on IP address. 21 | ## First entry that matches wins. If no SocksPolicy is set, we accept 22 | ## all (and only) requests that reach a SocksPort. Untrusted users who 23 | ## can access your SocksPort may be able to learn about the connections 24 | ## you make. 25 | #SocksPolicy accept 192.168.0.0/16 26 | #SocksPolicy reject * 27 | 28 | ## Logs go to stdout at level "notice" unless redirected by something 29 | ## else, like one of the below lines. You can have as many Log lines as 30 | ## you want. 31 | ## 32 | ## We advise using "notice" in most cases, since anything more verbose 33 | ## may provide sensitive information to an attacker who obtains the logs. 34 | ## 35 | ## Send all messages of level 'notice' or higher to /var/log/tor/notices.log 36 | #Log notice file /var/log/tor/notices.log 37 | ## Send every possible message to /var/log/tor/debug.log 38 | #Log debug file /var/log/tor/debug.log 39 | ## Use the system log instead of Tor's logfiles 40 | Log notice syslog 41 | ## To send all messages to stderr: 42 | #Log debug stderr 43 | 44 | ## Uncomment this to start the process in the background... or use 45 | ## --runasdaemon 1 on the command line. This is ignored on Windows; 46 | ## see the FAQ entry if you want Tor to run as an NT service. 47 | #RunAsDaemon 1 48 | 49 | ## The directory for keeping all the keys/etc. By default, we store 50 | ## things in $HOME/.tor on Unix, and in Application Data\tor on Windows. 51 | DataDirectory /var/lib/tor 52 | 53 | ## The port on which Tor will listen for local connections from Tor 54 | ## controller applications, as documented in control-spec.txt. 55 | #ControlPort 9051 56 | ## If you enable the controlport, be sure to enable one of these 57 | ## authentication methods, to prevent attackers from accessing it. 58 | #HashedControlPassword 16:872860B76453A77D60CA2BB8C1A7042072093276A3D701AD684053EC4C 59 | #CookieAuthentication 1 60 | 61 | ################### Ritochet Hidden Service ############# 62 | HiddenServiceDir /var/lib/tor/haskell-ricochet/ 63 | HiddenServicePort 9878 127.0.0.1:9878 64 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Protocol/Protobuf/ContactRequest.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Network.Ricochet.Protocol.Protobuf.ContactRequest 3 | Description: Lenses for ContactRequestChannel.proto messages 4 | 5 | These types and lenses are useful to deal with protobuf messages sent in 6 | relation with @im.ricochet.contact.request@ channels. They are used te 7 | introduce a new client and ask for user approval to send messages. 8 | @im.ricochet.auth.hidden-service@ authentication should be established 9 | beforehand. 10 | -} 11 | 12 | module Network.Ricochet.Protocol.Protobuf.ContactRequest 13 | ( contact_request 14 | , response 15 | , CR.ContactRequest (CR.ContactRequest) 16 | , nickname 17 | , message_text 18 | , R.Response (R.Response) 19 | , R.status 20 | , RS.Status (..) 21 | , nicknameMaxCharacters 22 | , messageMaxCharacters 23 | ) where 24 | 25 | import qualified Network.Ricochet.Protocol.Data.ContactRequest as CRE 26 | import qualified Network.Ricochet.Protocol.Data.ContactRequest.ContactRequest as CR 27 | import Network.Ricochet.Protocol.Data.ContactRequest.Limits 28 | import qualified Network.Ricochet.Protocol.Data.ContactRequest.Response as R 29 | import qualified Network.Ricochet.Protocol.Data.ContactRequest.Response.Status as RS 30 | import Network.Ricochet.Protocol.Data.Control.ChannelResult (ChannelResult) 31 | import Network.Ricochet.Protocol.Data.Control.OpenChannel (OpenChannel) 32 | 33 | import Network.Ricochet.Protocol.Protobuf (ext, utf8') 34 | 35 | import Control.Lens (Lens', Traversal', _Just) 36 | import Data.Text (Text) 37 | 38 | -- | Request a hidden service @onion@ domain to be added to the recipient’s 39 | -- contact list. This will usually prompt the recipient user. 40 | contact_request :: Traversal' OpenChannel CR.ContactRequest 41 | contact_request = ext CRE._contact_request . _Just 42 | 43 | -- | Respond to a contact request, informing the recipient in what status the 44 | -- request is. 45 | response :: Traversal' ChannelResult R.Response 46 | response = ext CRE._response . _Just 47 | 48 | -- | An optional nickname included in the contact request, that will be shown to 49 | -- the recipient user. It is limited to 'nicknameMaxCharacters' characters. 50 | nickname :: Traversal' CR.ContactRequest Text 51 | nickname = CR.nickname . _Just . utf8' 52 | 53 | -- | An optional message text included in the contact request, that will be 54 | -- shown to the recipient user. It is limited to 'messageMaxCharacters' 55 | -- characters. 56 | message_text :: Traversal' CR.ContactRequest Text 57 | message_text = CR.message_text . _Just . utf8' 58 | 59 | -- | The maximum amount of characters that is allowed in a nickname. This value 60 | -- is specified in the protocol buffer specification files. 61 | nicknameMaxCharacters :: Int 62 | nicknameMaxCharacters = fromEnum NicknameMaxCharacters 63 | 64 | -- | The maximum amount of characters that is allowed in a message. This value 65 | -- is specified in the protocol buffer specification files. 66 | messageMaxCharacters :: Int 67 | messageMaxCharacters = fromEnum MessageMaxCharacters 68 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Protocol/Protobuf/Chat.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Network.Ricochet.Protocol.Protobuf.Chat 3 | Description: Lenses for ChatChannel.proto messages 4 | 5 | "Network.Ricochet.Protocol.Protobuf.Chat" mostly re-exports lenses that are 6 | generated by hprotoc. One Maybe layer is removed from the record members of 7 | 'CP.Packet', and the name conflict between 'CM.message_id' and 'CA.message_id' 8 | is resolved by introducing 'HasMessageId'. 9 | -} 10 | 11 | module Network.Ricochet.Protocol.Protobuf.Chat 12 | ( CP.Packet (CP.Packet) 13 | , chat_message 14 | , chat_acknowledge 15 | , message_id 16 | , CM.ChatMessage (CM.ChatMessage) 17 | , message_text 18 | , time_delta 19 | , CA.ChatAcknowledge (CA.ChatAcknowledge) 20 | , accepted 21 | ) where 22 | 23 | import qualified Network.Ricochet.Protocol.Data.Chat.Packet as CP 24 | import qualified Network.Ricochet.Protocol.Data.Chat.ChatMessage as CM 25 | import qualified Network.Ricochet.Protocol.Data.Chat.ChatAcknowledge as CA 26 | 27 | import Network.Ricochet.Protocol.Protobuf (utf8') 28 | 29 | import Control.Lens (Traversal', Lens', _Just, 30 | non) 31 | import Data.Text (Text) 32 | import Data.Word (Word32) 33 | import Data.Int (Int64) 34 | import Text.ProtocolBuffers 35 | 36 | -- | Only the initiator of the channel should send a packet where this traversal 37 | -- yields a result. It contains a message composed by the user. 38 | chat_message :: Traversal' CP.Packet CM.ChatMessage 39 | chat_message = CP.chat_message . _Just 40 | 41 | -- | Only the non-initiator of the channel should send a packet where this 42 | -- traversal yields a result. It contains an acknowledgement that a message 43 | -- has been received. 44 | chat_acknowledge :: Traversal' CP.Packet CA.ChatAcknowledge 45 | chat_acknowledge = CP.chat_acknowledge . _Just 46 | 47 | class HasMessageId m where 48 | -- | We use the typeclass 'HasMessageId' because both 'CM.ChatMessage' and 49 | -- 'CA.ChatAcknowledge' have a @message_id@. 50 | -- 51 | -- If a @message_id@ is zero or ommitted, this means no acknowledgement is 52 | -- expected. If it is non-zero, the recipient should send a 53 | -- 'CA.ChatAcknowledge' with the same @message_id@. Unacknowledged messages 54 | -- may be re-sent with the same @message_id@, and the recipient should drop 55 | -- duplicate messages with an identical non-zero @message_id@, after sending 56 | -- an acknowledgement. 57 | message_id :: Lens' m (Maybe Word32) 58 | 59 | instance HasMessageId CM.ChatMessage where 60 | message_id = CM.message_id 61 | 62 | instance HasMessageId CA.ChatAcknowledge where 63 | message_id = CA.message_id 64 | 65 | -- | The text in a message. It should not exceed 66 | -- 'Network.Ricochet.Protocol.Protobuf.ContactRequest.messageMaxCharacters'. 67 | message_text :: Traversal' CM.ChatMessage Text 68 | message_text = CM.message_text . utf8' 69 | 70 | -- | The time this message was stored until it was sent, negative. 71 | time_delta :: Traversal' CM.ChatMessage Int64 72 | time_delta = CM.time_delta . _Just 73 | 74 | -- | Whether the acknowledged message has been accepted by the receiver. 75 | accepted :: Lens' CA.ChatAcknowledge Bool 76 | accepted = CA.accepted . non True 77 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Protocol/Lowest.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Network.Ricochet.Protocol.Lowest 3 | Description: Implementation of the low-level protocol parsing 4 | 5 | "Network.Ricochet.Protocol.Lowest" implements the parsing of the parts of the 6 | protocol which aren't described via Google Protobuf. 7 | -} 8 | 9 | {-# LANGUAGE TupleSections #-} 10 | module Network.Ricochet.Protocol.Lowest 11 | ( parsePacket 12 | , dumpPacket 13 | , splitIntoPackets 14 | , packet 15 | ) where 16 | 17 | import Network.Ricochet.Util (anyWord16, parserResult) 18 | import Network.Ricochet.Types (Packet (..), ParserResult (..), makePacket, 19 | _Success) 20 | 21 | import Prelude hiding (take) 22 | import Control.Lens (Prism', (^?), _1, prism') 23 | import Data.Attoparsec.ByteString (Parser, parse, take) 24 | import Data.Bifunctor (first) 25 | import Data.ByteString (ByteString ()) 26 | import qualified Data.ByteString as B 27 | import Data.ByteString.Builder (byteString, toLazyByteString, word16BE) 28 | import Data.ByteString.Lazy (toStrict) 29 | import Data.Monoid ((<>)) 30 | import Data.Word (Word16, Word8) 31 | 32 | 33 | -- | Actually parses a packet. 34 | parsePacket :: ByteString -> ParserResult Packet 35 | parsePacket bs = parserResult . parse packetParser $ bs 36 | 37 | -- | Parser for the low-level representation of a packet. 38 | packetParser :: Parser Packet 39 | packetParser = do 40 | size <- anyWord16 41 | channel <- anyWord16 42 | packetData <- take (fromIntegral size - 4) 43 | return $ MkPacket size channel packetData 44 | 45 | -- | Serializes a Packet to yield it’s low-level representation 46 | dumpPacket :: Packet -> ByteString 47 | dumpPacket (MkPacket w1 w2 bs) = toStrict . toLazyByteString $ word16BE w1 48 | <> word16BE w2 <> byteString bs 49 | 50 | -- | Prism for parsing and dumping a packet 51 | packet :: Prism' ByteString Packet 52 | packet = prism' dumpPacket ((^? _Success . _1) . parsePacket) 53 | 54 | -- | Split a ByteString into as many packets as necessary 55 | splitIntoPackets :: Word16 -- ^ ID of the channel the packets should be sent on 56 | -> ByteString -- ^ The ByteString to be split 57 | -> [Packet] -- ^ Returns a list of packets containing the ByteString 58 | splitIntoPackets chan bs = let (ps, bs') = splitIntoPackets' chan ([], bs) 59 | in ps <> [makePacket chan bs'] 60 | 61 | -- | Iteratively turn a ByteString into a series of maximal sized packets and 62 | -- return the rest 63 | splitIntoPackets' :: Word16 -- ^ ID of the channel the packets should be sent on 64 | -> ([Packet], ByteString) -- ^ A tuple of the packets created so far and the 65 | -- ByteString to consume 66 | -> ([Packet], ByteString) -- ^ Returns a tuple of the packets created and a 67 | -- ByteString shorter than the maximal packet length 68 | splitIntoPackets' chan (ps, bs) = 69 | case (toInteger . B.length $ bs) `compare` toInteger maxPackLen of 70 | EQ -> (ps <> [makePacket chan bs], B.empty) 71 | LT -> (ps, bs) 72 | -- Call the function again if there is some ByteString left 73 | GT -> splitIntoPackets' chan (ps <> [makePacket chan (B.take maxPackLen bs)], B.drop maxPackLen bs) 74 | where maxPackLen = fromIntegral (maxBound :: Word16) - 4 75 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Protocol/Protobuf/AuthHiddenService.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Network.Ricochet.Protocol.Protobuf.AuthHiddenService 3 | Description: AuthHiddenService.proto messages and their lenses 4 | 5 | These types and lenses are useful for dealing with protobuf messages sent in 6 | relation with @im.ricochet.auth.hidden-service@ channels. They are used to 7 | prove ownership of a hidden service name by demonstrating ownership of a 8 | matching private key. This is used to authenticate as a known contact, or to 9 | prove ownership of a service name before sending a contact request. 10 | 11 | See . 12 | -} 13 | 14 | {-# LANGUAGE NoMonomorphismRestriction #-} 15 | 16 | module Network.Ricochet.Protocol.Protobuf.AuthHiddenService 17 | ( client_cookie 18 | , server_cookie 19 | , AP.Packet (AP.Packet) 20 | , proof 21 | , result 22 | , AO.Proof (AO.Proof) 23 | , public_key 24 | , signature 25 | , AR.Result (AR.Result) 26 | , accepted 27 | , is_known_contact 28 | ) where 29 | 30 | import Network.Ricochet.Protocol.Data.AuthHiddenService 31 | import qualified Network.Ricochet.Protocol.Data.AuthHiddenService.Packet as AP 32 | import qualified Network.Ricochet.Protocol.Data.AuthHiddenService.Proof as AO 33 | import qualified Network.Ricochet.Protocol.Data.AuthHiddenService.Result as AR 34 | import Network.Ricochet.Protocol.Data.Control.ChannelResult (ChannelResult) 35 | import Network.Ricochet.Protocol.Data.Control.OpenChannel (OpenChannel) 36 | 37 | import Network.Ricochet.Protocol.Protobuf (ext) 38 | 39 | import Control.Lens (Lens', Traversal', _Just, 40 | strict) 41 | import Data.ByteString (ByteString) 42 | 43 | -- | The client’s part of the random string that will be used as an input to 44 | -- calculate the proof. 45 | client_cookie = ext _client_cookie 46 | 47 | -- | The server’s part of the random string that will be used as an input to 48 | -- calculate the proof. 49 | server_cookie = ext _server_cookie 50 | 51 | -- | If the 'AP.Packet' came from the client, it /must/ contain a 'Proof'. It 52 | -- is used to prove the ownership of a hidden service to the server. 53 | proof :: Traversal' AP.Packet AO.Proof 54 | proof = AP.proof . _Just 55 | 56 | -- | If the 'AP.Packet' came from the server, it /must/ contain a 'Result'. It 57 | -- is used to tell the client whether it’s proof has been accepted, and 58 | -- whether the hidden service is a known contact. 59 | result :: Traversal' AP.Packet AR.Result 60 | result = AP.result . _Just 61 | 62 | -- | The public key corresponding to the hidden service the client wants to 63 | -- prove ownership of. It has to be a DER-encoded 1024-bit RSA public key. 64 | -- It will be used to calculate the @onion@ address and verify the 65 | -- 'signature'. 66 | public_key :: Traversal' AO.Proof ByteString 67 | public_key = AO.public_key . _Just . strict 68 | 69 | -- | The signature of the HMAC-SHA256 proof, signed by the client’s hidden 70 | -- service’s private key. 71 | signature :: Traversal' AO.Proof ByteString 72 | signature = AO.signature . _Just . strict 73 | 74 | -- | Whether the public key was decoded and the signature verified successfully. 75 | -- If this is true, the client has @im.ricochet.auth.hidden-service@ 76 | -- authentication. 77 | accepted :: Lens' AR.Result Bool 78 | accepted = AR.accepted 79 | 80 | -- | Whether the client is a known contact already. This will only be true if 81 | -- 'accepted' is already true. In that case, the client has 82 | -- @im.ricochet.auth.hidden-service@ authentication as a known contact. 83 | is_known_contact :: Lens' AR.Result (Maybe Bool) 84 | is_known_contact = AR.is_known_contact 85 | -------------------------------------------------------------------------------- /CONTRIBUTING.adoc: -------------------------------------------------------------------------------- 1 | Hints for Contributors 2 | ====================== 3 | sternenseemann 4 | :showtitle: 5 | :author: sternenseemann 6 | 7 | == Git Workflow 8 | 9 | === Pulling & Pushing 10 | 11 | __Always__ use `git pull --rebase origin `! Always! If you have 12 | uncommited local changes `git stash` them. This will prevent ugly merge-commits 13 | in our `git log` and the need to interactively rebase from time to time. 14 | 15 | === Committing 16 | 17 | * Think before you commit! Do not commit incomplete changes. Check wether you 18 | are commiting on the right branch. 19 | * Run `cabal configure && cabal build` before you commit! Add new dependencies 20 | to `ricochet-haskell.cabal`. Fix compilation errors. 21 | * Split your changes into meaningful commits! If you have got unrelated changes 22 | in a file, use `git add -p ` to split these into separate commits. 23 | * Write meaningful, grammatically correct commit messages! Use the additional 24 | lines to write down all important aspects of the commit. 25 | 26 | Tip: If you have commited on the wrong branch, but not pushed yet you can do 27 | this: 28 | 29 | [source,shell] 30 | ---- 31 | git reset --soft HEAD~1 32 | git checkout 33 | git add 34 | git commit 35 | ---- 36 | 37 | See also: http://chris.beams.io/posts/git-commit/[Git commit] 38 | 39 | === Branching 40 | 41 | Create a new branch for every new feature or bigger change you develop! 42 | 43 | Smaller changes can be made on the master branch if you are sure that they won't 44 | conflict with anyone's changes. 45 | 46 | We don't have notion of stability yet but code on the master branch should 47 | compile at least. 48 | 49 | == Code 50 | 51 | * Use meaningful function names. 52 | * Use meaningful type names. 53 | * Write as much functional code as possible 54 | * Use two spaces as indentation. 55 | * Write haddock documentation comments (Make sure the text of multiline comments 56 | forms a neat block) 57 | * Use exact import declarations (example: `import Control.Monad (void, 58 | forever)`) 59 | * Try to keep your lines shorter than 81 characters. 60 | * … 61 | 62 | == Communication 63 | 64 | Please talk to the people! If everything is coordinated well, development will 65 | be much easier. 66 | 67 | These are the two communication channels we use: 68 | 69 | * Github issues for in depth discussion of concrete problems 70 | * IRC (`#ricochet` on freenode) for pretty much everything else (ranging from 71 | technical to more general to off-topic discussion) 72 | 73 | Be excellent to each other! 74 | 75 | === Modules 76 | 77 | If you're adding dependencies to external modules from hackage, please make sure 78 | the version on the `unstable`-channel of the `nixpkgs` is new enough for your 79 | changes to compile. 80 | 81 | If that is not the case, you'll have to add a custom nix-expression. 82 | 83 | To do that, first generate the expression using the `cabal2nix`-tool and place 84 | it in the `nix/` folder of the repository. 85 | [source,bash] 86 | ---- 87 | # Other possible sources for the expression can be listed by running: cabal2nix --help 88 | cabal2nix cabal://package-name > nix/package-name.nix 89 | ---- 90 | 91 | Now, you'll have just to add it to the override fold in `shell.nix`: 92 | [source,nix] 93 | ---- 94 | let 95 | haskellPackages' = builtins.foldl' over haskellPackages [ 96 | # ... 97 | (entry "package-name") 98 | # ... 99 | ]; 100 | in # ... 101 | ---- 102 | 103 | === Issues 104 | 105 | * Formulate clear issue titles 106 | * Write clear and concise comments 107 | * Label issues if you are allowed to 108 | * For bugs / errors supply… 109 | ** … the information how to reproduce 110 | ** … the error message 111 | * If you plan to resolve the issue, assign yourself to it. 112 | * You should use commits to automatically close issues (i. e. `Closes #`) 114 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Crypto.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoMonomorphismRestriction #-} 2 | {-| 3 | Module: Network.Ricochet.Crypto 4 | Description: Cryptographic primitives used internally by the library 5 | 6 | Since the cryptography libraries for haskell aren’t that great, we didn’t find 7 | everything we need. This module is a wrapper around the libraries we use, and 8 | adds our own implementations/bindings of primitives that aren’t defined 9 | elsewhere. 10 | -} 11 | 12 | module Network.Ricochet.Crypto 13 | ( generate1024BitRSA 14 | , hmacSHA256 15 | , hashSHA1 16 | , sign 17 | , verify 18 | , publicDER 19 | , privateDER 20 | , base64 21 | , public 22 | , torDomain 23 | , module Network.Ricochet.Crypto.RSA 24 | ) 25 | where 26 | 27 | import Network.Ricochet.Crypto.RSA 28 | 29 | import Control.Lens (Prism', Review, (^?), (#), _Right, prism', to, unto) 30 | import qualified Data.Base32String.Default as S32 (fromBytes, toText) 31 | import Data.ByteString (ByteString) 32 | import qualified Data.ByteString as B (take) 33 | import Data.ByteString.Base64 as B64 (encode, decode) 34 | import qualified Data.ByteString.Char8 as B8 (map) 35 | import qualified Data.Text.Encoding as T (encodeUtf8) 36 | import Data.Char (toLower) 37 | import Data.Maybe (fromJust) 38 | import OpenSSL (withOpenSSL) 39 | import OpenSSL.EVP.Digest (Digest, getDigestByName, hmacBS, digestBS) 40 | import OpenSSL.EVP.PKey (KeyPair, PublicKey) 41 | import OpenSSL.EVP.Sign (signBS) 42 | import OpenSSL.EVP.Verify (VerifyStatus(..), verifyBS) 43 | import OpenSSL.RSA (RSAKey, RSAKeyPair, RSAPubKey, generateRSAKey', 44 | rsaCopyPublic) 45 | import System.IO.Unsafe (unsafePerformIO) 46 | 47 | -- | Generate a 1024 bit private RSA key. The public exponent is 3. 48 | generate1024BitRSA :: IO RSAKeyPair 49 | generate1024BitRSA = generateRSAKey' 1024 3 50 | 51 | -- | The SHA256 Hash algorithm 52 | sha256 :: Digest 53 | sha256 = fromJust . unsafePerformIO . withOpenSSL $ getDigestByName "SHA256" 54 | 55 | -- | The SHA1 Hash algorithm 56 | sha1 :: Digest 57 | sha1 = fromJust . unsafePerformIO . withOpenSSL $ getDigestByName "SHA1" 58 | 59 | -- | Perform a secret key signing using HMAC-SHA256 60 | hmacSHA256 :: ByteString -- ^ The (shared) secret key 61 | -> ByteString -- ^ The data to be signed 62 | -> ByteString -- ^ The resulting HMAC signature 63 | hmacSHA256 key bs = hmacBS sha256 key bs 64 | 65 | -- | Hashes a 'ByteString' using 'sha1'. 66 | hashSHA1 :: ByteString -> ByteString 67 | hashSHA1 = digestBS sha1 68 | 69 | -- | Sign a ByteString using the algorithm corresponding to the passed KeyPair 70 | -- and SHA256. 71 | sign :: KeyPair k => k -> ByteString -> ByteString 72 | sign key bs = unsafePerformIO $ signBS sha256 key bs 73 | 74 | -- | Verify a signature using the algorithm corresponding to the passed KeyPair 75 | -- and SHA256. 76 | verify :: PublicKey k 77 | => k -- ^ The public key (or keypair) that belongs to the 78 | -- private key used to sign the message 79 | -> ByteString -- ^ The message that was signed 80 | -> ByteString -- ^ The signature that is to be verified 81 | -> Bool -- ^ Whether the signature is valid or not 82 | verify key msg sig = fromVerStat . unsafePerformIO $ verifyBS sha256 sig key msg 83 | where fromVerStat VerifySuccess = True 84 | fromVerStat VerifyFailure = False 85 | 86 | -- | A Prism that allows ASN.1 DER encoding and decoding of RSA public keys 87 | publicDER :: Prism' ByteString RSAPubKey 88 | publicDER = prism' toDERPub fromDERPub 89 | 90 | -- | A Prism that allows ASN.1 DER encoding and decoding of RSA private keys 91 | privateDER :: Prism' ByteString RSAKeyPair 92 | privateDER = prism' toDERPriv fromDERPriv 93 | 94 | -- | A Prism that allows Base64 encoding and decoding of ByteStrings 95 | base64 :: Prism' ByteString ByteString 96 | base64 = prism' B64.encode (^? to B64.decode . _Right) 97 | 98 | -- | This allows you to use an RSAKey where a RSAPubKey is required. 99 | public :: RSAKey k => Review RSAPubKey k 100 | public = unto $ unsafePerformIO . rsaCopyPublic 101 | 102 | -- | Compute the Tor domain name of some RSA key 103 | torDomain :: RSAKey k => k -> ByteString 104 | torDomain k = B8.map toLower . T.encodeUtf8 . S32.toText . S32.fromBytes . 105 | B.take 10 . hashSHA1 $ publicDER . public # k 106 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Types.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Network.Ricochet.Types 3 | Description: Most of the type and lens definitions 4 | 5 | "Network.Ricochet.Types" contains most of the definitions of the types and 6 | lenses used throughout the package. 7 | -} 8 | 9 | {-# LANGUAGE OverloadedStrings #-} 10 | {-# LANGUAGE TemplateHaskell #-} 11 | module Network.Ricochet.Types where 12 | 13 | import Control.Lens (makeLenses, makePrisms) 14 | import Data.Map (Map ()) 15 | import Data.Text (Text) 16 | import Control.Monad.IO.Class (MonadIO (..)) 17 | import Control.Monad.State (MonadState (..), StateT (..)) 18 | import Data.ByteString (ByteString ()) 19 | import qualified Data.ByteString as B (empty, length) 20 | import Data.Word (Word16) 21 | import Network.Socket (Socket ()) 22 | import System.IO (Handle ()) 23 | 24 | -- | Low level representation of a ricochet packet 25 | data Packet = MkPacket 26 | { _pSize :: Word16 -- ^ The size of the whole packet 27 | , _pChannelID :: Word16 -- ^ The channel the packet should be sent on 28 | , _pPacketData :: ByteString -- ^ The actual packet payload 29 | } deriving (Eq, Show) 30 | 31 | -- | Creates a packet with appropriate size from a Channel and a ByteString 32 | makePacket :: Word16 -- ^ ID of the channel the packet should be sent on 33 | -> ByteString -- ^ The ByteString to be sent 34 | -> Packet -- ^ Returns a sendable packet 35 | makePacket chan bs = MkPacket (4 + fromIntegral (B.length bs)) chan bs 36 | 37 | -- | The role of a peer in a Connection 38 | data ConnectionRole = Client | Server 39 | deriving (Eq, Show) 40 | 41 | -- | Representation of a connection between two ricochet peers 42 | -- it consists of: 43 | -- 44 | -- * open channels 45 | -- * wether our ricochet instance is the client 46 | data Connection = MkConnection 47 | { _cHandle :: Handle -- ^ The handle to send and receive signals on 48 | , _cChannels :: [Channel] -- ^ A list of the channels currently opened 49 | , _cInputBuffer :: ByteString -- ^ Buffered data that has not been parsed yet 50 | , _cConnectionRole :: ConnectionRole -- ^ The connection role of this side of the connection 51 | } 52 | 53 | -- | Equality is defined by equality of the socket 54 | instance Eq Connection where 55 | a == b = _cHandle a == _cHandle b 56 | 57 | -- | Creates an initial 'Connection' from a Handle 58 | makeConnection :: Handle -> ConnectionRole -> Connection 59 | makeConnection handle role = -- Start out with only a Control Channel 60 | let channels = [MkChannel 0 $ MkChannelType "im.ricochet.control-channel"] 61 | in MkConnection handle channels B.empty role 62 | 63 | -- | Low level representation of a ricochet channel 64 | data Channel = MkChannel 65 | { _cChannelID :: Word16 -- ^ The ID of the channel 66 | , _cChannelType :: ChannelType -- ^ The type of the channel 67 | } 68 | 69 | -- | Equality is defined by equality of the channel ID 70 | instance Eq Channel where 71 | a == b = _cChannelID a == _cChannelID b 72 | 73 | -- | The type of a channel is preliminarily represented by a ByteString for extensibility 74 | data ChannelType = MkChannelType Text 75 | deriving (Eq, Ord) 76 | 77 | -- | A contact, defined by his ID (Tor hidden service address without the .onion and the 'ricochet:' prefix) and his display name 78 | data Contact = MkContact 79 | { _cName :: String -- ^ The name assigned to the contact 80 | , _cRicochetID :: String -- ^ The ricochet ID of a contact is their hidden service address without the ".onion" 81 | , _cApproval :: ContactApproval -- ^ To what extent this contact is approved on both sides 82 | } deriving (Eq) 83 | 84 | -- | The contact request stage of a contact 85 | data ContactApproval = KnownContact 86 | | BlockedContact 87 | | WeRequestedContact 88 | | TheyRequestedContact 89 | deriving (Eq) 90 | 91 | -- | ParserResult holds the result of a parser in a way 92 | -- that is nice to handle within our library. 93 | data ParserResult a = Success a ByteString 94 | | Unfinished 95 | | Failure 96 | 97 | makeLenses ''Packet 98 | makeLenses ''Connection 99 | makeLenses ''Channel 100 | makeLenses ''Contact 101 | makeLenses ''ContactApproval 102 | makePrisms ''ParserResult 103 | -------------------------------------------------------------------------------- /haskell-ricochet.cabal: -------------------------------------------------------------------------------- 1 | name: haskell-ricochet 2 | version: 0.1.0.0 3 | synopsis: ricochet reimplementation in Haskell 4 | license: GPL-3 5 | license-file: LICENSE 6 | author: ricochet-haskell team 7 | maintainer: git@lukasepple.de 8 | category: Network 9 | build-type: Custom 10 | cabal-version: >=1.10 11 | 12 | library 13 | exposed-modules: Network.Ricochet 14 | , Network.Ricochet.Connection 15 | , Network.Ricochet.Crypto 16 | , Network.Ricochet.Monad 17 | , Network.Ricochet.Protocol.Lowest 18 | , Network.Ricochet.Protocol.Protobuf 19 | , Network.Ricochet.Protocol.Protobuf.AuthHiddenService 20 | , Network.Ricochet.Protocol.Protobuf.Chat 21 | , Network.Ricochet.Protocol.Protobuf.ContactRequest 22 | , Network.Ricochet.Protocol.Protobuf.ControlChannel 23 | , Network.Ricochet.Types 24 | , Network.Ricochet.Util 25 | , Network.Ricochet.Version 26 | other-modules: Network.Ricochet.Crypto.RSA 27 | , Network.Ricochet.Protocol.Data.AuthHiddenService 28 | , Network.Ricochet.Protocol.Data.AuthHiddenService.Packet 29 | , Network.Ricochet.Protocol.Data.AuthHiddenService.Proof 30 | , Network.Ricochet.Protocol.Data.AuthHiddenService.Result 31 | , Network.Ricochet.Protocol.Data.Chat.ChatAcknowledge 32 | , Network.Ricochet.Protocol.Data.Chat.ChatMessage 33 | , Network.Ricochet.Protocol.Data.Chat.Packet 34 | , Network.Ricochet.Protocol.Data.ContactRequest 35 | , Network.Ricochet.Protocol.Data.ContactRequest.ContactRequest 36 | , Network.Ricochet.Protocol.Data.ContactRequest.Limits 37 | , Network.Ricochet.Protocol.Data.ContactRequest.Response 38 | , Network.Ricochet.Protocol.Data.ContactRequest.Response.Status 39 | , Network.Ricochet.Protocol.Data.Control.ChannelResult 40 | , Network.Ricochet.Protocol.Data.Control.ChannelResult.CommonError 41 | , Network.Ricochet.Protocol.Data.Control.EnableFeatures 42 | , Network.Ricochet.Protocol.Data.Control.FeaturesEnabled 43 | , Network.Ricochet.Protocol.Data.Control.KeepAlive 44 | , Network.Ricochet.Protocol.Data.Control.OpenChannel 45 | , Network.Ricochet.Protocol.Data.Control.Packet 46 | 47 | build-depends: base 48 | , base32string 49 | , base64-bytestring 50 | , network 51 | , mtl 52 | , lens 53 | , network-anonymous-tor 54 | , text 55 | , transformers 56 | , bytestring 57 | , containers 58 | , attoparsec 59 | , socks 60 | , hprotoc 61 | , HsOpenSSL 62 | , protocol-buffers 63 | , protocol-buffers-descriptor 64 | , haskell-src-exts == 1.17.1 65 | hs-source-dirs: src 66 | default-language: Haskell2010 67 | 68 | executable server 69 | main-is: src/Demo/Server.hs 70 | build-depends: base 71 | , mtl 72 | , containers 73 | , bytestring 74 | , network 75 | , haskell-ricochet 76 | , lens 77 | default-language: Haskell2010 78 | 79 | executable client 80 | main-is: src/Demo/Client.hs 81 | build-depends: base 82 | , mtl 83 | , containers 84 | , bytestring 85 | , network 86 | , haskell-ricochet 87 | , lens 88 | default-language: Haskell2010 89 | 90 | test-suite tests 91 | type: exitcode-stdio-1.0 92 | main-is: Main.hs 93 | other-modules: Network.Ricochet.Testing.Instances 94 | , Network.Ricochet.Testing.Crypto 95 | -- , Network.Ricochet.Testing.General 96 | build-depends: base 97 | , haskell-ricochet 98 | , tasty 99 | , tasty-quickcheck 100 | , tasty-hunit 101 | , HUnit 102 | , QuickCheck 103 | , bytestring 104 | , lens 105 | , network 106 | , HsOpenSSL 107 | default-language: Haskell2010 108 | hs-source-dirs: test 109 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Connection.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Network.Ricochet.Connection 3 | Description: Implementation of everything related to initiating 'Connection's 4 | 5 | "Network.Ricochet.Connection" implements the opening of 'Connection's as well 6 | as the first few steps of the protocol. 7 | -} 8 | 9 | {-# LANGUAGE OverloadedStrings #-} 10 | 11 | module Network.Ricochet.Connection 12 | ( awaitConnection 13 | , connectTo 14 | ) where 15 | 16 | import Network.Ricochet.Monad (Ricochet, closeConnection, 17 | connections, serverSocket, socksPort, versions) 18 | import Network.Ricochet.Types (Connection, ConnectionRole(..), ParserResult(..), 19 | cHandle, cInputBuffer, makeConnection) 20 | import Network.Ricochet.Version (Versions, dumpIntroduction, parseIntroduction) 21 | 22 | import Control.Arrow (first) 23 | import Control.Concurrent (threadDelay) 24 | import Control.Lens ((%=), (^.), filtered, use) 25 | import Control.Monad (when) 26 | import Control.Monad.IO.Class (liftIO) 27 | import Data.ByteString (ByteString ()) 28 | import qualified Data.ByteString as B 29 | import qualified Data.Map as M 30 | import Data.Maybe (fromJust) 31 | import Data.Monoid ((<>)) 32 | import Network (PortID (..), accept, listenOn) 33 | import Network.Socks5 (socksConnectTo) 34 | import System.IO (BufferMode (..), Handle (), hSetBuffering) 35 | 36 | -- | Waits until a new peer connects to initiate a connection 37 | awaitConnection :: Ricochet Connection 38 | awaitConnection = do 39 | sock <- use serverSocket 40 | (handle, _, _) <- liftIO $ accept sock 41 | initiateConnection handle Server 42 | 43 | -- | Connects to a peer through the Tor network 44 | connectTo :: String -- ^ Tor hidden service identifier to connect to 45 | -> PortID -- ^ Port to connect to 46 | -> Ricochet Connection -- ^ Returns the established connection 47 | connectTo domain port = do 48 | torPort <- use socksPort 49 | handle <- liftIO $ socksConnectTo "localhost" (PortNumber torPort) domain port 50 | initiateConnection handle Client 51 | 52 | -- | Initiate a newly made connection. This includes the version negotiation 53 | -- and running the corresponding version handler 54 | initiateConnection :: Handle -- ^ Handle corresponding to the connection to the peer 55 | -> ConnectionRole -- ^ The connection role of this side of the connection 56 | -> Ricochet Connection -- ^ Returns the finished 'Connection' 57 | initiateConnection handle role = do 58 | connection <- createConnection handle role 59 | case role of 60 | Client -> offerVersions connection 61 | Server -> pickVersion connection 62 | return connection 63 | 64 | -- | Creates a new 'Connection' and adds it to the list of open Connections 65 | createConnection :: Handle -- ^ Handle corresponding to the connection to the peer 66 | -> ConnectionRole -- ^ The connection role of this side of the connection 67 | -> Ricochet Connection -- ^ Returns the finished 'Connection' 68 | createConnection handle role = do 69 | -- Create the actual connection structure 70 | let connection = makeConnection handle role 71 | -- Disable buffering 72 | liftIO $ hSetBuffering handle NoBuffering 73 | -- Add it to the list of open Connections 74 | connections %= (<> [connection]) 75 | return connection 76 | 77 | -- | Offers the available versions to the newly connected peer and starts the 78 | -- handler corresponding to the one the peer picked 79 | offerVersions :: Connection -> Ricochet () 80 | offerVersions connection = do 81 | availableVersions <- use versions 82 | -- Send the available versions 83 | liftIO . B.hPutStr (connection ^. cHandle) $ dumpIntroduction availableVersions 84 | response <- liftIO $ B.hGet (connection ^. cHandle) 1 85 | let choice = head $ B.unpack response 86 | -- If the choice is valid 87 | if choice `M.member` availableVersions 88 | -- Start the handler corresponding to the negotiated version 89 | then availableVersions M.! choice $ connection 90 | else closeConnection connection 91 | 92 | -- | Picks a version supported by the peer and starts the corresponding handler 93 | pickVersion :: Connection -> Ricochet () 94 | pickVersion connection = do 95 | availableVersions <- use versions 96 | response <- liftIO . awaitIntroMessage availableVersions $ connection ^. cHandle 97 | case fmap (first M.toList) response of 98 | -- No matching versions 99 | Just ([], rest) -> do 100 | liftIO . B.hPutStr (connection ^. cHandle) $ B.singleton 0xFF 101 | closeConnection connection 102 | -- The versions match 103 | Just (handlers, rest) -> do 104 | -- Always choose the latest version 105 | let chosen = maximum (fmap fst handlers) 106 | liftIO . B.hPutStr (connection ^. cHandle) $ B.singleton chosen 107 | -- Append the rest of the response to the inputBuffer 108 | connections . traverse . filtered (== connection) . cInputBuffer %= (<> rest) 109 | -- Start the chosen handler 110 | (fromJust $ lookup chosen handlers) connection 111 | Nothing -> closeConnection connection 112 | 113 | -- | Waits for the peer to send the introductory message 114 | awaitIntroMessage :: Versions -> Handle -> IO (Maybe (Versions, ByteString)) 115 | awaitIntroMessage vers handle = do 116 | introMessage <- B.hGetNonBlocking handle 300 117 | case parseIntroduction vers introMessage of 118 | Success map b -> return $ Just (map, b) 119 | Unfinished -> liftIO (threadDelay delay) >> awaitIntroMessage vers handle 120 | Failure -> return Nothing 121 | where delay = round $ 10 ** 4 122 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Crypto/RSA.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | {-| 3 | Module: Network.Ricochet.Crypto.RSA 4 | Description: DER-encoding and decoding of RSA keys compatible with HsOpenSSL 5 | 6 | This module binds to the parts of OpenSSL required for DER-encoding and decoding 7 | RSA keys. We have sent a PR to the HsOpenSSL project, but it has not been 8 | accepted yet. 9 | -} 10 | 11 | module Network.Ricochet.Crypto.RSA 12 | ( fromDERPub 13 | , toDERPub 14 | , fromDERPriv 15 | , toDERPriv 16 | , rawRSASign 17 | , rawRSAVerify 18 | ) 19 | where 20 | 21 | #include 22 | #include 23 | 24 | import Data.ByteString (ByteString) 25 | import qualified Data.ByteString as B (useAsCStringLen) 26 | import qualified Data.ByteString.Internal as BI (createAndTrim) 27 | import Foreign.ForeignPtr (ForeignPtr, finalizeForeignPtr, newForeignPtr, 28 | withForeignPtr) 29 | import Foreign.Ptr (FunPtr, Ptr, freeHaskellFunPtr, nullFunPtr, nullPtr) 30 | import Foreign.C.String (CString) 31 | import Foreign.C.Types (CLong(..), CInt(..), CUInt(..)) 32 | import Foreign.Marshal.Alloc (alloca) 33 | import Foreign.Storable (peek, poke) 34 | import Data.Word (Word8) 35 | import OpenSSL.RSA (RSA, RSAKey, RSAKeyPair, RSAPubKey, absorbRSAPtr, rsaSize, 36 | withRSAPtr) 37 | import System.IO.Unsafe (unsafePerformIO) 38 | 39 | type CDecodeFun = Ptr (Ptr RSA) -> Ptr CString -> CLong -> IO (Ptr RSA) 40 | type CEncodeFun = Ptr RSA -> Ptr (Ptr Word8) -> IO CInt 41 | 42 | foreign import ccall unsafe "d2i_RSAPublicKey" 43 | _fromDERPub :: CDecodeFun 44 | 45 | foreign import ccall unsafe "i2d_RSAPublicKey" 46 | _toDERPub :: CEncodeFun 47 | 48 | foreign import ccall unsafe "d2i_RSAPrivateKey" 49 | _fromDERPriv :: CDecodeFun 50 | 51 | foreign import ccall unsafe "i2d_RSAPrivateKey" 52 | _toDERPriv :: CEncodeFun 53 | 54 | -- | Generate a function that decodes a key from ASN.1 DER format 55 | makeDecodeFun :: RSAKey k => CDecodeFun -> ByteString -> Maybe k 56 | makeDecodeFun fun bs = unsafePerformIO . usingConvedBS $ \(csPtr, ci) -> do 57 | -- When you pass a null pointer to this function, it will allocate the memory 58 | -- space required for the RSA key all by itself. It will be freed whenever 59 | -- the haskell object is garbage collected, as they are stored in ForeignPtrs 60 | -- internally. 61 | rsaPtr <- fun nullPtr csPtr ci 62 | if rsaPtr == nullPtr then return Nothing else absorbRSAPtr rsaPtr 63 | where usingConvedBS io = B.useAsCStringLen bs $ \(cs, len) -> 64 | alloca $ \csPtr -> poke csPtr cs >> io (csPtr, fromIntegral len) 65 | 66 | -- | Generate a function that encodes a key in ASN.1 DER format 67 | makeEncodeFun :: RSAKey k => CEncodeFun -> k -> ByteString 68 | makeEncodeFun fun k = unsafePerformIO $ do 69 | -- When you pass a null pointer to this function, it will only compute the 70 | -- required buffer size. See https://www.openssl.org/docs/faq.html#PROG3 71 | requiredSize <- withRSAPtr k $ flip fun nullPtr 72 | -- It’s too sad BI.createAndTrim is considered internal, as it does a great 73 | -- job here. See https://hackage.haskell.org/package/bytestring-0.9.1.4/docs/Data-ByteString-Internal.html#v%3AcreateAndTrim 74 | BI.createAndTrim (fromIntegral requiredSize) $ \ptr -> 75 | alloca $ \pptr -> 76 | (fromIntegral <$>) . withRSAPtr k $ \key -> 77 | poke pptr ptr >> fun key pptr 78 | 79 | -- | Dump a public key to ASN.1 DER format 80 | toDERPub :: RSAKey k 81 | => k -- ^ You can pass either 'RSAPubKey' or 'RSAKeyPair' 82 | -- because both contain the necessary information. 83 | -> ByteString -- ^ The public key information encoded in ASN.1 DER 84 | toDERPub = makeEncodeFun _toDERPub 85 | 86 | -- | Parse a public key from ASN.1 DER format 87 | fromDERPub :: ByteString -> Maybe RSAPubKey 88 | fromDERPub = makeDecodeFun _fromDERPub 89 | 90 | -- | Dump a private key to ASN.1 DER format 91 | toDERPriv :: RSAKeyPair -> ByteString 92 | toDERPriv = makeEncodeFun _toDERPriv 93 | 94 | -- | Parse a private key from ASN.1 DER format 95 | fromDERPriv :: RSAKey k 96 | => ByteString -- ^ The private key information encoded in ASN.1 DER 97 | -> Maybe k -- ^ This can return either 'RSAPubKey' or 98 | -- 'RSAKeyPair' because there’s sufficient 99 | -- information for both. 100 | fromDERPriv = makeDecodeFun _fromDERPriv 101 | 102 | foreign import ccall unsafe "RSA_sign" 103 | _rsa_sign :: CInt -> CString -> CUInt -> Ptr Word8 -> Ptr CUInt -> Ptr RSA -> IO CInt 104 | 105 | foreign import ccall unsafe "RSA_verify" 106 | _rsa_verify :: CInt -> CString -> CUInt -> CString -> CUInt -> Ptr RSA -> IO CInt 107 | 108 | _nid_sha256 :: CInt 109 | _nid_sha256 = #const NID_sha256 110 | 111 | -- | Sign a hash digest using the given RSA key, assuming the digest was 112 | -- produced with sha256. This function is required because the ricochet 113 | -- protocol doesn’t sha256-hash the sha256-hmac’ed proof before signing. (The 114 | -- non-raw version of this function hashes its input before signing.) 115 | rawRSASign :: RSAKeyPair -> ByteString -> ByteString 116 | rawRSASign k bs = unsafePerformIO $ do 117 | -- The signature is of the same length as the key modulus 118 | let requiredSize = rsaSize k 119 | BI.createAndTrim (fromIntegral requiredSize) $ \ptr -> 120 | (fromIntegral <$>) . alloca $ \iptr -> 121 | B.useAsCStringLen bs $ \(cs, len) -> 122 | withRSAPtr k $ \key -> 123 | poke iptr 0 >> 124 | _rsa_sign _nid_sha256 cs (fromIntegral len) ptr iptr key >> 125 | peek iptr 126 | 127 | -- | Verify that a signature was created using the given hash digest and the 128 | -- given RSA key, assuming the digest was produced with sha256. This function 129 | -- is required because the ricochet protocol doesn’t sha256-hash the 130 | -- sha256-hmac’ed proof before signing. (The non-raw version of this function 131 | -- hashes its input before verifying.) 132 | rawRSAVerify :: RSAKey k => k -> ByteString -> ByteString -> Bool 133 | rawRSAVerify k dig sig = (== 1) . unsafePerformIO $ do 134 | withRSAPtr k $ \key -> 135 | B.useAsCStringLen dig $ \(cdig, dlen) -> 136 | B.useAsCStringLen sig $ \(csig, slen) -> 137 | _rsa_verify _nid_sha256 cdig (fromIntegral dlen) csig (fromIntegral slen) key 138 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Protocol/Protobuf/ControlChannel.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Network.Ricochet.Protocol.Protobuf.ControlChannel 3 | Description: Lenses for ControlChannel.proto messages 4 | 5 | These types and lenses are useful for dealing with packets sent in control 6 | channels. It’s the only channel open from the beginning of a connection, and 7 | can thus be used to open the other channels. Additionally, you can send 8 | 'K.KeepAlive' packets and enable protocol extensions using 'E.EnableFeatures'. 9 | -} 10 | 11 | module Network.Ricochet.Protocol.Protobuf.ControlChannel 12 | ( CP.Packet (CP.Packet) 13 | -- | Every 'CP.Packet' should contain such data that only one of the following 14 | -- traversals will yield a result: 15 | , open_channel 16 | , channel_result 17 | , keep_alive 18 | , enable_features 19 | , features_enabled 20 | , channel_identifier 21 | , O.OpenChannel 22 | , channel_type 23 | , R.ChannelResult 24 | , opened 25 | , common_error 26 | , CE.CommonError (..) 27 | , K.KeepAlive 28 | , response_requested 29 | , E.EnableFeatures (E.EnableFeatures) 30 | , F.FeaturesEnabled (F.FeaturesEnabled) 31 | , feature 32 | ) where 33 | 34 | import qualified Network.Ricochet.Protocol.Data.Control.Packet as CP 35 | import qualified Network.Ricochet.Protocol.Data.Control.OpenChannel as O 36 | import qualified Network.Ricochet.Protocol.Data.Control.ChannelResult as R 37 | import qualified Network.Ricochet.Protocol.Data.Control.ChannelResult.CommonError as CE 38 | import qualified Network.Ricochet.Protocol.Data.Control.KeepAlive as K 39 | import qualified Network.Ricochet.Protocol.Data.Control.EnableFeatures as E 40 | import qualified Network.Ricochet.Protocol.Data.Control.FeaturesEnabled as F 41 | 42 | import Network.Ricochet.Protocol.Protobuf (utf8', i32) 43 | import Network.Ricochet.Types (ChannelType(..)) 44 | 45 | import Control.Lens (Lens', Traversal', _Just, 46 | below, iso) 47 | import Data.ByteString (ByteString) 48 | import Data.Text (Text) 49 | import GHC.Word (Word16) 50 | import Text.ProtocolBuffers (Seq) 51 | 52 | -- | A request to to open an additional channel. The receiver should check its 53 | -- validity and reply with a 'R.ChannelResult' message. 54 | open_channel :: Lens' CP.Packet (Maybe O.OpenChannel) 55 | open_channel = CP.open_channel 56 | 57 | -- | Response to an 'O.OpenChannel' message, telling the receiver whether the 58 | -- channel is ready for use, or what has gone wrong. 59 | channel_result :: Lens' CP.Packet (Maybe R.ChannelResult) 60 | channel_result = CP.channel_result 61 | 62 | -- | A ping/pong message. This can be used to ping the remote side, ie. to find 63 | -- out how much latency the connection has. 64 | keep_alive :: Lens' CP.Packet (Maybe K.KeepAlive) 65 | keep_alive = CP.keep_alive 66 | 67 | -- | Request to activate protocol extension features. The remote side has to 68 | -- respond with a 'F.FeaturesEnabled' message. 69 | enable_features :: Lens' CP.Packet (Maybe E.EnableFeatures) 70 | enable_features = CP.enable_features 71 | 72 | -- | Response to an 'E.EnableFeatures' message, telling the receiver which of 73 | -- the requested features have been enabled. 74 | features_enabled :: Lens' CP.Packet (Maybe F.FeaturesEnabled) 75 | features_enabled = CP.features_enabled 76 | 77 | class HasChannelIdentifier m where 78 | -- | We use the typeclass 'HasChannelIdentifier' because both 'O.OpenChannel' 79 | -- and 'R.ChannelResult' have a @channel_identifier@. 80 | -- 81 | -- The channel identifier of either a 'O.OpenChannel' or a 'R.ChannelResult' 82 | -- message. It is used to correlate both packets with a channel and a 83 | -- ChannelResult message with the OpenChannel one. 84 | -- 85 | -- The standard specifies several rules to follow when choosing or accepting 86 | -- a channel identifier: 87 | -- 88 | -- * The client side of a connection may only open odd-numbered channels 89 | -- * The server side may only open even-numbered channels 90 | -- * The identifier must fit within the range of uint16 91 | -- * The identifier must not be used by an open channel 92 | -- * The identifier should increase for every OpenChannel message, wrapping 93 | -- if necessary. Identifiers should not be re-used except after wrapping. 94 | channel_identifier :: Lens' m Word16 95 | 96 | instance HasChannelIdentifier O.OpenChannel where 97 | channel_identifier = O.channel_identifier . iso fromIntegral fromIntegral 98 | 99 | instance HasChannelIdentifier R.ChannelResult where 100 | channel_identifier = R.channel_identifier . iso fromIntegral fromIntegral 101 | 102 | -- | The type of the requested channel. By convention, it is in reverse URI 103 | -- format, e.g. @im.ricochet.chat@. It specifies what kind of extensions to 104 | -- the 'O.OpenChannel' and 'R.ChannelResult' messages are allowed, and what 105 | -- kind of packets will be sent in the channel. 106 | channel_type :: Traversal' O.OpenChannel ChannelType 107 | channel_type = O.channel_type . utf8' . iso MkChannelType fromChannelType 108 | where fromChannelType (MkChannelType t) = t 109 | 110 | -- | Whether the requested channel is now open and ready to receive packets. 111 | opened :: Lens' R.ChannelResult Bool 112 | opened = R.opened 113 | 114 | -- | The error code that describes why the channel cannot be opened. 115 | common_error :: Lens' R.ChannelResult (Maybe CE.CommonError) 116 | common_error = R.common_error 117 | 118 | -- | Whether this ping should be answered with a pong. In other words, the 119 | -- remote side will reply to a 'K.KeepAlive' message with 'response_requested' 120 | -- set to True (=ping) with a 'K.KeepAlive' message with 'response_requested' 121 | -- set to False (=pong). 122 | response_requested :: Lens' K.KeepAlive Bool 123 | response_requested = K.response_requested 124 | 125 | class HasFeature m where 126 | -- | We use the typeclass 'HasFeature' because both 'E.EnableFeatures' and 127 | -- 'F.FeaturesEnabled' have @feature@s. 128 | -- 129 | -- In the request, this is the list of features that one side of the 130 | -- connection wishes to enable. In the response, this will be all of the 131 | -- features supported by the recipient of the request, that are now enabled. 132 | feature :: Traversal' m (Seq Text) 133 | 134 | instance HasFeature E.EnableFeatures where 135 | feature = E.feature . below utf8' 136 | 137 | instance HasFeature F.FeaturesEnabled where 138 | feature = F.feature . below utf8' 139 | -------------------------------------------------------------------------------- /src/Network/Ricochet/Monad.hs: -------------------------------------------------------------------------------- 1 | 2 | {- | 3 | Module: Network.Ricochet.Monad 4 | Description: Implementation of the 'Ricochet'-Monad 5 | 6 | "Network.Ricochet.Monad" contains the definition and implementation of the 7 | 'Ricochet'-Monad, as well as some useful functions in it. 8 | -} 9 | 10 | {-# LANGUAGE FlexibleContexts #-} 11 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 12 | {-# LANGUAGE TemplateHaskell #-} 13 | {-# LANGUAGE NoMonomorphismRestriction #-} 14 | 15 | module Network.Ricochet.Monad 16 | ( Ricochet (..) 17 | , RicochetState (..) 18 | , serverSocket, hiddenDomain 19 | , connections, peekPacket 20 | , nextPacket, socksPort 21 | , versions, sendPacket 22 | , sendByteString, closeConnection 23 | , startRicochet, RicochetConfig (..) 24 | ) where 25 | 26 | import Network.Ricochet.Protocol.Lowest 27 | import Network.Ricochet.Types 28 | import Network.Ricochet.Util 29 | 30 | import Control.Applicative (Applicative (..)) 31 | import Control.Concurrent (threadDelay) 32 | import Control.Lens ((<%=), (%=), (^.), makeLenses, use) 33 | import Control.Monad (void, forever) 34 | import Control.Monad.IO.Class (MonadIO (..), liftIO) 35 | import Control.Monad.State (MonadState (..), StateT (..), evalStateT) 36 | import Data.Base32String.Default (toText) 37 | import Data.ByteString (ByteString ()) 38 | import qualified Data.ByteString as B 39 | import Data.List (delete) 40 | import Data.Map (Map (), lookup, empty, fromList) 41 | import Data.Monoid ((<>)) 42 | import Data.Text (toLower) 43 | import Data.Text.Encoding (encodeUtf8) 44 | import Data.Word (Word8, Word16) 45 | import Network.Socket (Socket (), PortNumber (..), socket, bind, 46 | inet_addr, SocketType (..), defaultProtocol, 47 | SockAddr (..), Family (..)) 48 | import Network.BSD (getServicePortNumber) 49 | import Network.Anonymous.Tor (mapOnion, withSession) 50 | import System.IO (BufferMode (..), Handle (), hSetBuffering, hClose) 51 | 52 | 53 | -- | The Ricochet Monad which allows stateful network computations 54 | newtype Ricochet a = Ricochet { runRicochet :: StateT RicochetState IO a } 55 | deriving ( Functor, Applicative, Monad 56 | , MonadIO, MonadState RicochetState) 57 | 58 | -- | RicochetState is the state necessary for Ricochet 59 | data RicochetState = MkRicochetState 60 | { _serverSocket :: Socket -- ^ The socket listening for new peers 61 | , _hiddenDomain :: ByteString -- ^ The domain of our hidden service 62 | , _connections :: [Connection] -- ^ A list of the current open connections 63 | , _contactList :: [Contact] -- ^ A list of known contacts 64 | , _socksPort :: PortNumber -- ^ The port of the local Tor SOCKS proxy 65 | , _versions :: Map Word8 (Connection -> Ricochet ()) -- ^ A map mapping version numbers to handlers 66 | } 67 | 68 | -- | Lenses for RicochetState 69 | -- 70 | makeLenses ''RicochetState 71 | 72 | 73 | -- | Checks if a complete packet is available on the given connection, and if 74 | -- so, reads and returns it. 75 | -- 76 | peekPacket :: Connection -> Ricochet (Maybe Packet) 77 | peekPacket con = do 78 | readBytes <- liftIO $ B.hGetNonBlocking (con ^. cHandle) maxPacketSize 79 | -- Append the read bytes to the input buffer 80 | inputBuffer <- con' . cInputBuffer <%= (<> readBytes) 81 | -- Try parsing a full packet and return it on success 82 | case parsePacket inputBuffer of 83 | Success packet bs -> do 84 | -- Remove the parsed portion from the inputBuffer 85 | -- FIXME: Should be: con' . cInputBuffer .= bs 86 | con' . cInputBuffer <%= const bs 87 | return $ Just packet 88 | Unfinished -> return Nothing 89 | Failure -> return Nothing 90 | -- Todo: quit connection for unreadable packages? 91 | where maxPacketSize = fromIntegral (maxBound :: Word16) 92 | con' = connections . look con 93 | chan' p = con' . cChannels . lookWith cChannelID (p ^. pChannelID) 94 | 95 | 96 | -- | Waits for a complete packet to arrive and returns it 97 | -- 98 | nextPacket :: Connection -> Ricochet Packet 99 | nextPacket con = do 100 | maybePacket <- peekPacket con 101 | case maybePacket of 102 | Just pkt -> return pkt 103 | Nothing -> liftIO (threadDelay delay) >> nextPacket con 104 | where delay = 10 ^ 6 -- μs -> 1s 105 | 106 | 107 | -- | Sends a Packet to a connected User 108 | -- 109 | sendPacket :: Connection -> Packet -> Ricochet () 110 | sendPacket con pkt = liftIO . B.hPutStr (con ^. cHandle) $ dumpPacket pkt 111 | 112 | 113 | -- | Packs a ByteString into Packets and sends it through the given Connection 114 | -- 115 | sendByteString :: Connection -- ^ The Connection through which to send the ByteString 116 | -> Word16 -- ^ The ID of the channel the ByteString should be sent on 117 | -> ByteString -- ^ The ByteString to be sent 118 | -> Ricochet () 119 | sendByteString con chan bs = mapM_ (sendPacket con) $ splitIntoPackets chan bs 120 | 121 | 122 | -- | Closes a connection and removes it from the list of connections 123 | -- 124 | closeConnection :: Connection -> Ricochet () 125 | closeConnection connection = do 126 | connections %= delete connection 127 | liftIO . hClose $ connection ^. cHandle 128 | 129 | data RicochetConfig = RicochetConfig 130 | { rcPort :: PortNumber -- ^ Port to listen on 131 | , rcPrivKey :: Maybe ByteString -- ^ RSA1024 private key in base64 encoding 132 | , rcControlPort :: PortNumber -- ^ The Tor control port 133 | , rcSocksPort :: PortNumber -- ^ The port of the Tor SOCKS5 proxy 134 | , rcHandlers :: [(Word8, Connection -> Ricochet ())] -- ^ A list of version identifiers and their 135 | -- corresponding 'Connection' handlers 136 | } 137 | 138 | 139 | -- | Start an action inside the Ricochet monad. 140 | -- 141 | -- This function uses a Tor control socket to create the hidden service. 142 | -- If no key is supplied, the hidden service will be random 143 | -- 144 | startRicochet :: RicochetConfig 145 | -> [Contact] -- ^ A list of known 'Contact's 146 | -> Ricochet () 147 | -> IO () 148 | startRicochet config contacts action = do 149 | let key = rcPrivKey config 150 | listenInt = fromIntegral lPort 151 | ctrlInt = fromIntegral . rcControlPort $ config 152 | lPort = rcPort config 153 | cPort = rcSocksPort config 154 | 155 | listenSock <- socket AF_INET Stream defaultProtocol 156 | addr <- inet_addr "127.0.0.1" 157 | bind listenSock (SockAddrInet listenInt addr) 158 | void . withSession ctrlInt $ \ctrlSock -> do 159 | address <- encodeUtf8 . toLower . toText <$> mapOnion ctrlSock listenInt listenInt False key 160 | startRicochet' listenSock address contacts (rcSocksPort config) (rcHandlers config) action 161 | 162 | 163 | -- | Start an action inside the Ricochet monad. 164 | -- 165 | -- This function assumes the listening socket was already configured to be a 166 | -- hidden service via the torrc or some other method. 167 | -- 168 | -- DON'T use this function if that's not the case. 169 | -- 170 | startRicochet' :: Socket -- ^ Socket to listen on 171 | -> ByteString -- ^ Domain of the already configured hidden service 172 | -> [Contact] -- ^ A list of known contacts 173 | -> PortNumber -- ^ The port of the Tor SOCKS5 proxy 174 | -> [(Word8, Connection -> Ricochet ())] -- ^ A list of version identifiers and their 175 | -- corresponding 'Connection' handlers 176 | -> Ricochet () -- ^ The action to execute 177 | -> IO () 178 | startRicochet' sock address contacts soxPort versions action = 179 | let versions' = fromList versions 180 | state = MkRicochetState sock address [] contacts soxPort versions' 181 | in flip evalStateT state . runRicochet $ action 182 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | --------------------------------------------------------------------------------