diff --git a/Barracuda.cabal b/Barracuda.cabal
new file mode 100644
--- /dev/null
+++ b/Barracuda.cabal
@@ -0,0 +1,99 @@
+Name:         Barracuda
+Version:      1.0.2
+License:      GPL
+License-File: LICENSE
+Author:       Stephan Friedrichs <stephan.friedrichs@tu-bs.de>,
+              Henning Günther <h.guenther@tu-bs.de>,
+              Oliver Mielentz <o.mielentz@tu-bs.de>,
+              Martin Wegner <mw@mroot.net>
+
+Stability:    Stable
+Category:     Network
+Synopsis:     An ad-hoc P2P chat program
+Description:  An ad-hoc chat program developed in the software development
+              course at the TU-Braunschweig. Barracuda (by Stephan Friedrichs,
+              Henning Günther, Oliver Mielentz and Martin Wegner) implements an
+              ad-hoc (p2p) network. On top of that, a chat application has been realised.
+              .
+              Just like in IRC, the communication is organised in channels. A channel may be
+              anonymous (the messages' origin is obscured), private (encrypted, only invited
+              users may join them) or public (free for all users).
+              .
+              The design is elaborated in a series of RFCs (see for example
+              <http://tools.ietf.org/html/draft-strauss-p2p-chat>).
+              .
+              The Darcs repository can be found at <http://repos.mroot.net/sep07-adhoc>
+Homepage:     http://sep07.mroot.net/
+
+Build-Depends:  base>=3,
+                Crypto,
+                HaXml>=1.17,
+                utf8-string,
+                array,
+                bytestring>0.9,
+                containers,
+                dataenc,
+                directory,
+                filepath>=1.0,
+                gtk,
+                mtl,
+                network,
+                old-locale,
+                parsec>=2.0,
+                random,
+                regex-compat,
+                stm>=2.0,
+                time,
+                unix,
+                pkcs1>=1.0.2,
+                heap>=0.2,
+                hsgnutls>=0.2.3-barracuda,
+                xml-parsec>=1.0.2,
+                adhoc-network>=1.0.2
+Build-Type:     Simple
+
+extra-source-files: Tests.hs, Tests/Data.hs, Tests/HUnit/RoutingTable.hs,
+                    Tests/HUnit/PendingAck.hs, Tests/HUnit/ChannelList.hs,
+                    Tests/QuickCheck/Encryption.hs, Tests/QuickCheck/X509.hs,
+                    Tests/QuickCheck/Parser.hs
+
+Extensions:     FunctionalDependencies,
+                MultiParamTypeClasses,
+                RecursiveDo,
+                FlexibleContexts,
+                TypeSynonymInstances,
+                RelaxedPolyRec,
+                FlexibleInstances,
+                ExistentialQuantification
+
+Exposed-Modules: Barracuda.CertificateList
+                 Barracuda.ChannelList
+                 Barracuda.Distributor
+                 Barracuda.GUI
+                 Barracuda.GUI.CertificateLoader
+                 Barracuda.GUI.ChannelCreator
+                 Barracuda.GUI.ChannelList
+                 Barracuda.GUI.ChannelManager
+                 Barracuda.GUI.DownloadManager
+                 Barracuda.GUI.Infrastructure
+                 Barracuda.GUI.InputField
+                 Barracuda.GUI.UserList
+                 Barracuda.GUI.ServerInterface
+                 Barracuda.GUI.ChatView
+                 Barracuda.GUI.Utils
+                 Barracuda.LocalUserInfo
+                 Barracuda.PendingAck
+                 Barracuda.PendingAnonymous
+                 Barracuda.PendingKey
+                 Barracuda.PendingRoute
+                 Barracuda.RoutingTable
+                 Barracuda.ServerState
+                 Barracuda.TimedCollection
+                 Barracuda.Utils
+
+ghc-options:    -threaded
+
+Executable:     Barracuda
+Main-Is:        Main.hs
+ghc-options:    -threaded
+
diff --git a/Barracuda/CertificateList.hs b/Barracuda/CertificateList.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/CertificateList.hs
@@ -0,0 +1,92 @@
+-- |
+-- Maintainer: Stephan Friedrichs, Henning Guenther
+--
+-- This module contains a list for the known certificates of internal and external users.
+-- It also contains functions to cache the certificates on the hard disk.
+module Barracuda.CertificateList (
+	CertificateList,
+	certificates,
+	dumpCertificateList,
+	loadCertificateList,
+	verify
+) where
+
+import Control.Exception
+import Control.Monad
+import Data.ByteString (readFile,writeFile)
+import Data.Map as Map
+import Data.Maybe(catMaybes)
+import Network.GnuTLS hiding (verifySignature)
+import Network.GnuTLS.X509 hiding (verifySignature)
+import Prelude hiding (writeFile,readFile)
+import System.Directory
+import System.FilePath
+import Text.Regex
+
+import Network.AdHoc.Signature
+import Network.AdHoc.UserID
+
+-- | Stores the 'Certificate' of every user in the network.
+type CertificateList = Map UserID Certificate
+
+certRegex :: Regex
+certRegex = mkRegex "(.*)\\.cert"
+
+isCertificate :: FilePath -> Maybe String
+isCertificate path = do
+	[user] <- matchRegex certRegex path
+	return user
+
+-- | Returns a complete list of 'UserID's and their 'Certificate's.
+certificates :: CertificateList -> [(UserID, Certificate)]
+certificates = assocs
+
+genPath :: FilePath -> UserID -> FilePath
+genPath path user = path </> userHost user </> userName user ++ ".cert"
+
+writeCertificate :: FilePath -> UserID -> Certificate -> IO ()
+writeCertificate path user cert = do
+	let check_dir = path </> userHost user
+	dirExists <- doesDirectoryExist check_dir
+	unless dirExists (createDirectory check_dir)
+	let outp = either (error.show) id (exportCertificate cert X509FmtPem)
+	writeFile (genPath path user) outp
+
+readCertificate :: FilePath -> String -> IO (Maybe (String,Certificate))
+readCertificate path file = case isCertificate file of
+	Just user -> do
+		str <- readFile (path </> file)
+		either (error.show) (\cert -> return $ Just (user,cert)) (importCertificate str X509FmtPem)
+	Nothing -> return Nothing
+
+verify :: CertificateList -> String -> Signature -> UserID -> SignatureStatus
+verify cl str sig user = case Map.lookup user cl of
+	Nothing -> CertificateMissing (verifySignature str sig)
+	Just cert -> verifySignature str sig cert
+
+-- | Writes the certificate list into a directory(dir). It uses the following schema:
+--   dir\/host\/user.cert
+dumpCertificateList :: CertificateList -> FilePath -> IO ()
+dumpCertificateList cl path = do
+	exists <- doesDirectoryExist path
+	createDirectoryIfMissing True path
+	conts <- getDirectoryContents path
+	mapM_ (\dir -> unless (dir=="."||dir=="..") (removeDirectoryRecursive (path </> dir))) conts
+	mapM_ (uncurry $ writeCertificate path) (certificates cl)
+
+-- | Loads the certificate list from a given location using the same schema as 'dumpCertificateList'.
+loadCertificateList :: FilePath -> IO CertificateList
+loadCertificateList path = do
+	exists <- doesDirectoryExist path
+	if exists
+		then do
+			conts <- getDirectoryContents path
+			certs <- mapM (\host -> do
+				conts' <- getDirectoryContents (path </> host)
+				mapM (\user -> do
+					cert <- readCertificate (path </> host) user
+					return $ maybe Nothing (\(ruser,rcert) -> Just (UserID ruser host,rcert)) cert
+					) (drop 2 conts')
+				) (drop 2 conts)
+			return $ fromList $ catMaybes $concat certs
+		else return Map.empty
diff --git a/Barracuda/ChannelList.hs b/Barracuda/ChannelList.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/ChannelList.hs
@@ -0,0 +1,211 @@
+-- |
+-- Maintainer: Stephan Friedrichs
+--
+-- This module represents the channel logic of the protocoll; i.e. for example when channels have
+-- to be announced, merged and deleted or the management of private keys associated with private
+-- channels.
+module Barracuda.ChannelList (
+	ChannelList(..),
+	KeyList(..),
+	ChannelMap
+) where
+
+import Barracuda.TimedCollection
+import qualified Data.List as List
+import qualified Data.Map as Map
+import Data.Monoid
+import qualified Data.Set as Set
+import Data.Time
+import Data.Word
+import Network.AdHoc.Channel
+import Network.AdHoc.UserID
+import Prelude hiding (lookup)
+
+-- | A @ChannelList@ manages information about channelnames, -types and -members retreived
+--   via the network. Note that this datastructure only contains information about public
+--   and private channels and not about the anonymous channel.
+class (Monoid c, TimedCollection c) => ChannelList c where
+	-- | Lets the given user join a channel. If the cannel is unknown, the information is ignored.
+	--   Normally this function is called to handle the protocols JOIN messages.
+	join          :: UserID -> ChannelName -> ChannelID -> c -> c
+	-- | Makes a user leave a channel. Called to suffice the protocols LEAVE messages.
+	leave         :: UserID -> ChannelName -> ChannelID -> c -> c
+	-- | This function takes the information of a channel broadcast and updates the collection.
+	--   According to the protocol specs, it merges public channels with the same name and
+	--   different ids, but keeps private channels with the same name and different ids
+	--   separated.
+	update        :: UTCTime -- ^ Timestamp for the channel announcement
+		-> ChannelName   -- ^ The Name of the affected channel
+		-> ChannelID     -- ^ ID of the affected channel
+		-> String        -- ^ The channel description
+		-> Bool          -- ^ True if the channel is private
+		-> [UserID]      -- ^ The users within the concerned channel
+		-> c -> c
+	-- | Retrieves all information about a given combination of 'ChannelName'
+	--   and 'ChannelID' if it is known.
+	lookup        :: ChannelName -> ChannelID -> c -> Maybe (Bool, String, Set.Set UserID)
+	-- | Looks up all information about a public channel with the given 'ChannelName', if known.
+	lookupPublic  :: ChannelName -> c -> Maybe (ChannelID, String, Set.Set UserID)
+	-- | Retreives a list of all documented channels. The @String@ is the channel
+	--   description, the @Bool@ indicates whether they are private.
+	channels      :: c -> [(ChannelName, ChannelID, String, Bool)]
+	-- | Find out whether a channel with the given name exists.
+	exists        :: ChannelName -> c -> Bool
+	-- | Find out, if a given Channel is private. If and only if the combination
+	--   of ('ChannelName', 'ChannelID') is unknown, 'Nothing' is returned. As a
+	--   consequence, 'Just' indicates, that the combination is definitely stored.
+	isPrivate     :: ChannelName -> ChannelID -> c -> Maybe Bool
+	-- | Finds all users in any channel.
+	usersAll      :: c -> Set.Set UserID
+	-- | Retreives all users in a given channel.
+	usersChannel  :: ChannelName -> ChannelID -> c -> Set.Set UserID
+	-- | This function takes a set of locally active users, the current time and a new timestamp.
+	--   It returns a list of channels, that have to be announced as their timestamps have run out
+	--   and a local user is active in them. The new 'ChannelList' returned is purged of all channels
+	--   whose timeouts have run out and that don't have a local active user; the timestamps
+	--   of the priorily mentioned channels (local user active and timestamp run out) have been updated
+	--   as well.
+	announcePurge :: Set.Set UserID -- ^ All locally active users
+		-> UTCTime              -- ^ The current point of time
+		-> UTCTime              -- ^ A new timestamp
+		-> c -> (c, [(ChannelName, ChannelID, String, Set.Set UserID, Bool)])
+	-- | Returns a map suitable for using in 'Barracuda.GUI.ServerInterface.ControlResponse'.
+	channelMap    :: c -> Map.Map (ChannelName, ChannelID) (String, Bool, Set.Set UserID)
+
+-- | A class representing collections able to store the symmetric keys for private channels.
+--   Each private channel is represented by its 'ChannelName' and 'ChannelID' and may be
+--   associated either with its key or a timestamp of the last key request. The default
+--   implementation is 'ChannelMap'.
+class Monoid k => KeyList k where
+	-- | Log that the key for the given channel has been requested at the given point of time.
+	--   This does not override an already retreived key (in this case this call is just ignored).
+	request  :: UTCTime -> ChannelName -> ChannelID -> k -> k
+	-- | Insert a successfully requested key into the 'KeyList'.
+	insert   :: ChannelName -> ChannelID -> Word64 -> k -> k
+	-- | Gets the key for a channel, if and only if it is known and the user is allowed to have it.
+	getKey   :: UserID -> ChannelName -> ChannelID -> k -> Maybe Word64
+	-- | Returns if the key for the given channel has already been locally stored.
+	keyKnown :: ChannelName -> ChannelID -> k -> Bool
+	-- | Returns a list of unanswered requests above a certain timeout.
+	unknown  :: UTCTime         -- ^ The current point of time.
+		-> NominalDiffTime  -- ^ An acceptable timeout. Requests within this timeout are not returned.
+		-> k -> [(ChannelName, ChannelID)]
+
+-- | The default implementation of 'ChannelList'.
+data ChannelMap = ChannelMap
+	{ public  :: Map.Map  ChannelName (ChannelID,  String, Set.Set UserID, UTCTime)
+	, private :: Map.Map (ChannelName, ChannelID) (String, Set.Set UserID, UTCTime, KeyStatus Word64)
+	} deriving (Show, Eq, Ord)
+
+data KeyStatus a
+	= NoInterest
+	| Requested UTCTime
+	| Acquainted a
+	deriving (Show, Eq, Ord)
+
+instance Monoid ChannelMap where
+	mempty = ChannelMap Map.empty Map.empty
+	mappend (ChannelMap m1 m2) (ChannelMap n1 n2) = ChannelMap (Map.union m1 n1) (Map.union m2 n2)
+
+instance TimedCollection ChannelMap where
+	deleteBefore now cm = cm
+		{ public  = Map.filter (\(_, _, _, time) -> time >= now) $ public  cm
+		, private = Map.filter (\(_, _, time, _) -> time >= now) $ private cm
+		}
+
+instance ChannelList ChannelMap where
+	join uid name cid cm = if name == anonymous then cm else cm
+		{ public  = Map.adjust (\(cid', msg, users, time) -> if cid == cid'
+			then (cid, msg, Set.insert uid users, time)
+			else (cid', msg, users, time)) name $ public cm
+		, private = Map.adjust (\(msg, users, time, key) -> (msg, Set.insert uid users, time, key))
+			(name, cid) $ private cm
+		}
+	leave uid name cid cm = if name == anonymous then cm else cm
+		{ public  = Map.update (\(cid', msg, users, time) -> if cid' == cid
+				then let users' = Set.delete uid users in if Set.null users'
+					then Nothing
+					else Just (cid, msg, users', time)
+				else Just (cid', msg, users, time)
+			) name $ public cm
+		, private = Map.update (\(msg, users, time, key) -> let users' = Set.delete uid users in if Set.null users'
+				then Nothing
+				else Just (msg, users', time, key)
+			) (name, cid) $ private cm
+		}
+	update time name cid msg encrypted users cm = if name == anonymous then cm else if encrypted
+		then cm { private = Map.insertWith
+				(\(msg, users, time, _) (_, _, _, key) -> (msg, users, time, key))
+				(name, cid) (msg, Set.fromList users, time, NoInterest) $ private cm
+			}
+		else cm { public  = Map.insertWith
+				(\(cid, msg, users, time) (cid', _, users', _) -> (
+					min cid cid', msg,
+					if cid == cid' then users else Set.union users users',
+					time)
+				)
+				name (cid, msg, Set.fromList users, time) $ public cm
+			}
+	lookup name cid cm = case Map.lookup name (public cm) of
+			Just (cid1, msg1, users1, _) -> if cid == cid1
+				then Just (False, msg1, users1)
+				else privateResult
+			Nothing                      -> privateResult
+		where privateResult = do
+			(msg2, users2, _, _) <- Map.lookup (name, cid) (private cm)
+			return (True, msg2, users2)
+	lookupPublic name cm = Map.lookup name (public cm) >>= return.(\(cid, msg, users, _) -> (cid, msg, users))
+	channels cm = (Map.foldWithKey (\ n     (i, m, _, _) cs -> (n, i, m, False):cs) [] $ public  cm)
+		   ++ (Map.foldWithKey (\(n, i) (m, _, _, _) cs -> (n, i, m, True ):cs) [] $ private cm)
+	exists name cm = Map.member name (public cm) || Set.member name (Set.map fst (Map.keysSet (private cm)))
+	isPrivate name cid cm = lookup name cid cm >>= return.(\(p, _, _) -> p)
+	usersAll cm = Set.union
+		(Map.fold (\(_, _, u, _) users -> Set.union users u) Set.empty $ public  cm)
+		(Map.fold (\(_, u, _, _) users -> Set.union users u) Set.empty $ private cm)
+	usersChannel name cid cm = case Map.lookup name (public cm) of
+		Just (cid', _, users, _) -> if cid == cid' then users else privateUsers
+		Nothing                  -> privateUsers
+		where privateUsers = case Map.lookup (name, cid) (private cm) of
+			Nothing               -> Set.empty
+			Just (_, users, _, _) -> users
+	announcePurge users now ts cm = let
+			(ann1, public') = Map.mapAccumWithKey
+				(\ann name (cid, msg, users', time) -> if (time < now)
+					&& not (Set.null $ Set.intersection users' users)
+					then ((name, cid, msg, users', False):ann, (cid, msg, users', ts))
+					else (ann, (cid, msg, users', time))
+				) [] $ public cm
+			(ann2, private') = Map.mapAccumWithKey
+				(\ann (name, cid) (msg, users', time, key) -> if (time < now)
+					&& not (Set.null $ Set.intersection users' users)
+					then ((name, cid, msg, users', True):ann, (msg, users', ts, key))
+					else (ann, (msg, users', time, key))
+				) [] $ private cm
+		in (deleteBefore now cm { public = public', private = private' }, ann1 ++ ann2)
+	channelMap cm = let
+		p1 = map (\(name, (cid, title, users, _)) -> ((name, cid),(title, False, users))) (Map.toList (public cm))
+		p2 = map (\(key, (title, users, _, _))    -> (key, (title, True, users))) (Map.toList (private cm))
+		in Map.fromList $ p1 ++ p2
+
+instance KeyList ChannelMap where
+	request now name cid cm = cm
+		{ private = Map.adjust (\(msg, users, time, key) -> (msg, users, time, max key (Requested now)))
+			(name, cid) $ private cm
+		}
+	insert name cid key cm = cm
+		{ private = Map.adjust (\(msg, users, time, _) -> (msg, users, time, Acquainted key))
+			(name, cid) $ private cm
+		}
+	getKey uid name cid cm = case Map.lookup (name, cid) (private cm) of
+		Just (_, users, _, Acquainted key) -> if Set.member uid users then Just key else Nothing
+		_                                  -> Nothing
+	keyKnown name cid cm = case Map.lookup (name, cid) (private cm) of
+		Just (_, _, _, Acquainted _) -> True
+		_                            -> False
+	unknown now timeout cm = Map.foldWithKey (\(name, cid) (_, _, _, key) requests -> case key of
+			Requested time -> if now > addUTCTime timeout time
+				then (name, cid) : requests
+				else requests
+			_              -> requests
+		) [] $ private cm
+
diff --git a/Barracuda/Distributor.hs b/Barracuda/Distributor.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/Distributor.hs
@@ -0,0 +1,1001 @@
+{-# LANGUAGE FlexibleContexts, RelaxedPolyRec #-}
+-- | Maintainer: Henning Guenther, Martin Wegner
+--
+-- This is the main component of Barracuda. It contains the logic of messages flow in
+-- the application. In this case, \'message\' does means 'DistributorMsg's rather than
+-- only protocol messages.
+module Barracuda.Distributor
+	( DistributorMsg(..)
+	, DistributorChan
+	, processMessage
+	) where
+
+import Control.Monad.State hiding (mapM_,forM_)
+import Control.Concurrent.Chan
+import Data.Array (Array, listArray, bounds, (!))
+import qualified Data.ByteString as BS
+import Data.Time.Clock
+import Data.Word
+import Data.Foldable (foldl,forM_)
+import Data.Map as Map hiding (map, (\\), (!))
+import qualified Data.Set as Set
+import Data.List as List ((\\),partition,filter,null)
+import Data.Maybe (listToMaybe)
+import Network.BSD
+import Network.GnuTLS.X509
+import qualified Network.GnuTLS as GnuTLS
+import Network.Socket hiding (shutdown)
+import Prelude hiding (foldl)
+import System.Random
+import System.IO
+import Text.XML.HaXml.Parse(xmlParse')
+import Text.XML.HaXml.Pretty
+
+import Barracuda.ServerState
+import Barracuda.RoutingTable as RT
+import Barracuda.CertificateList (verify)
+import Barracuda.ChannelList as CL
+import Barracuda.PendingAck as PAck
+import Barracuda.PendingRoute as PRoute
+import Barracuda.PendingAnonymous as PAnon
+import Barracuda.PendingKey as PKey
+import Barracuda.LocalUserInfo as LocInf
+import Barracuda.TimedCollection
+import Barracuda.GUI.ServerInterface hiding (sendMessage)
+import Network.AdHoc.Encryption
+import Network.AdHoc.Message
+import Network.AdHoc.MessageID
+import Network.AdHoc.ParserStrict
+import Network.AdHoc.Generator
+import Network.AdHoc.Routing
+import Network.AdHoc.UserID
+import Network.AdHoc.Signature
+import Network.AdHoc.Channel
+
+-- | The Distributor is mainly controlled via distributor messages. They can be created
+--   and be given to the 'processMessage' function to be processed on the "ServerState".
+data DistributorMsg
+	= ProtMsg SockAddr String -- ^ A message received from the network.
+	| NewGUI UserID Certificate PrivateKey (ControlResponse -> IO ()) -- ^ Signals that a new GUI was created.
+	| GUIMsg UserID ControlMessage -- ^ 'ControlMessage's from one of the connected GUIs.
+	| TimeMsg -- ^ A timer message constantly pinging the Distributor to trigger certain periodic actions like sending HELLOs, etc.
+	| InfraMsg (Maybe (Set.Set SockAddr)) -- ^ A message containing a set of 'SockAddr'esses being the list of known peers. Used for infrastructure mode.
+
+-- | Through this channel the Distributor receives the 'DistributorMsg's.
+type DistributorChan = Chan (UTCTime, DistributorMsg)
+
+-- ------------------------
+-- - PROCESSING FUNCTIONS -
+-- ------------------------
+
+type ObscureMessage = Either (String, [ Attachment ], UTCTime) (UserID, RSAEncrypted String)
+
+-- | Main routine of the Distributor: 'processMessage' takes a 'DistributorMsg' and processes it.
+--   This includes: Periodic sending of HELLOs and ROUTINGs triggered by timer messages,
+--   processing all received protocol messages and updating the stored information about the network
+--   in the "ServerState" respectively sending further messages (e. g. to the remaining non-local receivers).
+--   And additionally it connects the protocol backend of the program to the connected GUIs. Local users
+--   are registered to the Distributor, and the Distributor distributes all incoming messages for local users
+--   to those connected users respectively taking messages from them to be sent to the network.
+processMessage :: DistributorMsg -> ServerMonad ()
+--
+-- Infrastructure message
+--
+processMessage (InfraMsg set) = do
+	btrace $ "Infrastructure: " ++ show set
+	modify (\st -> st {infrastructure = set})
+--
+-- Timer message
+--
+processMessage TimeMsg = do
+	localUsers <- withLocalUserInfo $ query $ LocInf.users
+	-- Send hello message
+	unless (Set.null localUsers) $ do
+		greeting <- withRandom (\gen -> let (i, g) = randomR (bounds hellos) gen in (g, i)) >>= return.(hellos!)
+		sendMessageBroadcast (Hello (Set.toList localUsers) 1 (Just greeting))
+	time <- curTime
+	-- Remove old entries from the routing table
+	withRoutingTable $ manipulate $ deleteBefore (addUTCTime (-6) time)
+	-- Distribute channel information so that we can update the users in the anonymous channel for all GUIs
+	-- (users might have been added or have timeouted)
+	distributeChannelInformation
+	-- Shuffle messages that await routing etc.
+	messageShuffle
+	-- Send routing messages
+	timedSendRouting
+	-- Purge anonymous messages that have timeouted
+	withPendingAnonymous $ manipulate $ PAnon.purgeZeroTTL
+	-- Try to resend Anonymous messages that were not posted after a timeout of 60 seconds
+	anon <- withPendingAnonymous $ PAnon.purgeNotPosted time 60
+	-- Count down TTL of remaining anonymous messages
+	let ranon = map (\anonMsg -> anonMsg { ttl = if (ttl anonMsg) > 60 then (ttl anonMsg) - 60 else 0 }) anon
+	-- Try to resend anonymous messages
+	mapM_ sendAnonymous ranon
+	-- re-announce channels
+	channelsToAnnounce <- withChannelList $ CL.announcePurge localUsers (addUTCTime (-60) time) time
+	mapM_ announceChannel channelsToAnnounce
+	-- re-request keys for private channels that have not yet arrived here
+	channelsToRequest <- withChannelList $ query $ CL.unknown time 60
+	mapM_ (\(cname, cid) -> requestPrivChanKey cname cid) channelsToRequest
+--
+-- Protocol message
+--
+processMessage (ProtMsg from str) = do
+	st <- get
+	case xmlParse' (show from) str >>= parseMessage (verify (certificates st)) of
+		Left err -> berror $ "Failed to parse message: " ++ err ++ "Failed message: " ++ str
+		Right msg -> do
+			case (infrastructure st) of
+				Nothing -> processProtocolMessage from msg
+				Just peers -> if Set.member from peers
+					then processProtocolMessage from msg
+					else btrace $ "Dropped packet from " ++ show from ++ " due to infrastructure"
+--
+-- GUI creation and close messages
+--
+processMessage (NewGUI uid cert pk handle) = do
+	withLocalUserInfo $ manipulate $ Map.insert uid (Set.empty, pk, handle)
+	withCertificates  $ manipulate $ Map.insert uid cert
+	distributeChannelInformation
+processMessage (GUIMsg user CMClose) = do
+	userInfo <- withLocalUserInfo $ query $ Map.lookup user
+	case userInfo of
+		Just (channels, privkey, _) -> do
+			mapM_ (\(cname, cid) -> leaveUser user privkey cname cid) (Set.toList channels)
+			withLocalUserInfo $ manipulate $ Map.delete user
+			newUsers <- withLocalUserInfo $ query id
+			when (Map.null newUsers) shutdown
+		Nothing -> return () -- should not happen
+--
+-- GUI message
+--
+processMessage (GUIMsg user (WantJoin cname cid)) = do
+	userInfo <- withLocalUserInfo $ query $ Map.lookup user
+	case userInfo of
+		Just (channels, privkey, handle) -> do
+			isPrivate <- withChannelList $ query $ CL.isPrivate cname cid
+			case isPrivate of
+				Just True -> return ()
+				_ -> do
+					withLocalUserInfo $ manipulate $ Map.insert user (Set.insert (cname, cid) channels, privkey, handle)
+					withChannelList $ manipulate $ CL.join user cname cid
+					distributeChannelInformation
+			joinUser user privkey cname cid
+		Nothing -> berror $ "Got GUIMsg from user " ++ (show user) ++ " that I do not know?!"
+processMessage (GUIMsg user (WantLeave cname cid)) = do
+	userInfo <- withLocalUserInfo $ query $ Map.lookup user
+	case userInfo of
+		Just (channels, privkey, handle) -> do
+			withLocalUserInfo $ manipulate $ Map.insert user (Set.delete (cname, cid) channels, privkey, handle)
+			leaveUser user privkey cname cid
+			withChannelList $ manipulate $ leave user cname cid
+			distributeChannelInformation
+		Nothing -> berror $ "Got GUIMsg from user " ++ (show user) ++ " that I do not know?!"
+processMessage (GUIMsg sender (SendMsg cname cid text attachments)) = do
+	time <- curTime
+	if mkChannelName "Anonymous" == cname
+		then sendAnonymous (PendingAnonymousMessage 360 sender text attachments time)
+		else do
+			privKey <- withLocalUserInfo $ query $ privateKey sender
+			-- query users in channel
+			usersChannel <- withChannelList $ query $ CL.usersChannel cname cid
+			btrace $ "Received message to be sent from local user "++(show sender)
+			-- partition them into local and non-local users
+			(localRecv, nonLocalRecv) <- partitionLocals usersChannel
+			btrace $ "Forwarding to: "++(show localRecv)++", "++(show nonLocalRecv)
+			case privKey of
+				Just rprivKey -> do
+					unless (Set.null nonLocalRecv) $ sendMsgToChannel sender rprivKey cname cid (Set.toList nonLocalRecv) text attachments
+					mapM_ ((flip sendUser) (Receive cname cid (Just sender) text attachments time False)) (Set.toList localRecv)
+				Nothing -> berror $ "Got GUIMsg from user " ++ (show sender) ++ " that I do not have a private key of?!"
+processMessage (GUIMsg user (CreateChannel name desc invite)) = do
+	-- check whether channel exists
+	channelExists <- withChannelList $ query $ CL.exists name
+	if channelExists
+		then
+			-- tell user that channel already exists
+			sendUser user (ErrGeneral MessageWarning "Channel name already occupied"
+				("A channel with the name '" ++ show name
+				++ "' already exists, so I'm unable to create the channel."))
+		else do
+			case validateChannelName name of
+				Just err -> sendUser user (ErrGeneral MessageInfo "Unable to create channel" err)
+				Nothing  -> do -- in this case, Nothing means that everything's alright
+					userInfo <- withLocalUserInfo $ query $ Map.lookup user
+					case userInfo of
+						Just (channels, privKey, handle) -> do
+							time <- curTime
+							channelID <- newChannelId
+							msgID <- newMessageId
+							(private, key, channelUsers) <- case invite of
+								Just users -> do
+									key <- withRandom (\gen -> let (res, ngen) = generateDESKey gen in (ngen, res))
+									return (True, Just key, Set.toList (Set.insert user users))
+								Nothing -> return (False, Nothing, [ user ])
+							-- add channel to ChannelList
+							btrace $ "Inserting channel into ChannelList ..."
+							withChannelList $ manipulate $ CL.update time name channelID desc private channelUsers
+							-- if channel is private insert the key
+							case key of
+								Just rkey -> withChannelList $ manipulate $ CL.insert name channelID rkey
+								Nothing -> return ()
+							-- announce channel
+							sendMessageBroadcast (Flood (Routed 48 user msgID (Channel name channelID desc channelUsers private) (Left privKey)))
+							-- add channel to LocalUserInfo for the user
+							withLocalUserInfo $ manipulate $ Map.insert user (Set.insert (name, channelID) channels, privKey, handle)
+							distributeChannelInformation
+						Nothing -> berror $ "Got GUIMsg from user " ++ (show user) ++ " that I do not know?!"
+processMessage (GUIMsg sender (Authorize user cname cid)) = do
+	privKey <- withLocalUserInfo $ query $ privateKey sender
+	case privKey of
+		Just rprivKey -> do
+			-- join the user, then query updated information about the channel and re-send announcement
+			withChannelList $ manipulate $ CL.join user cname cid
+			channelInfo <- withChannelList $ query $ CL.lookup cname cid
+			case channelInfo of
+				Just (private, desc, users) -> do
+					msgID <- newMessageId
+					sendMessageBroadcast (Flood (Routed 48 sender msgID (Channel cname cid desc (Set.toList users) private) (Left rprivKey)))
+				Nothing -> return ()
+		Nothing -> berror $ "Got GUIMsg from user " ++ (show user) ++ " that I do not know?!"
+
+messageShuffle :: ServerMonad ()
+messageShuffle = do
+	time <- curTime
+	-- Get messages that were not successfully sent to the next hop
+	noAck <- withPendingAck (purgeNoAck time 2) -- Wait 2 seconds for an ACK message
+	-- And reinsert	them into the PendingRoute structure
+	withPendingRoute $ manipulate $
+		flip (foldl (\pr (routed,arrived,tried) -> PRoute.reinsert arrived routed tried pr)) noAck
+	-- Get the routing table
+	rt <- withRoutingTable $ query id
+	-- Find new routes for pending messages
+	newRoutes <- withPendingRoute $ routeAndDelete rt
+	-- And send the messages along them
+	mapM_ (\(addr,rt,tried,recv_time) -> resend addr rt tried recv_time) newRoutes
+
+sendRouting :: ServerMonad ()
+sendRouting = do
+	-- Find all neighbors
+	neighborhood <- withRoutingTable $ query neighbors
+	users <- withLocalUserInfo $ query users
+	-- And send them routing messages
+	mapM_ (\addr -> do
+		routes <- withRoutingTable $ query $ mergeRoutesFor addr users
+		sendMessage addr (Routing (Map.toList routes))
+		) (Set.toList neighborhood)
+
+nextRoutingInterval :: ServerMonad ()
+nextRoutingInterval = do
+	now <- curTime
+	interval <- withRandom (\gen -> let (res,ngen) = randomR (8,10) gen in (ngen,res))
+	st <- get
+	put $ st { nextRouting = (fromInteger interval) `addUTCTime` now }
+
+timedSendRouting :: ServerMonad ()
+timedSendRouting = do
+	now <- curTime
+	st <- get
+	when (now >= nextRouting st) $ do
+		sendRouting
+		nextRoutingInterval
+		rt <- withRoutingTable $ query id
+		btrace $ show rt
+
+processProtocolMessage :: SockAddr -> ExternalMessage -> ServerMonad ()
+processProtocolMessage from msg = case msg of
+	Hello users vers greet -> do
+		time <- curTime
+		lusers <- withLocalUserInfo $ query $ LocInf.users
+		when (Set.null $ Set.intersection lusers (Set.fromList users))
+			$ withRoutingTable $ manipulate $ RT.hello time from users
+	Ack sender msgid -> do
+		-- The PendingAck structure needs to be updated
+		withPendingAck $ manipulate $ ack sender msgid from
+	Routing routes -> do
+		time <- curTime
+		withRoutingTable $ manipulate $ RT.routing time from routes
+		rt <- withRoutingTable $ query id
+		btrace $ "Received routing message " ++ show rt
+	Flood (Routed ttl sender msgid fc sig) -> do
+		let processCall = do
+			again <- floodAgain sender msgid
+			when (again && ttl >= 1) $ do
+				processFlood sender msgid fc sig
+				when (ttl > 1) $ sendMessageBroadcast (Flood (Routed (ttl-1) sender msgid fc (toInternal sig)))
+		case sig of
+			Nothing -> processCall
+			Just (_, sigStatus) -> case sigStatus of
+				SignatureWrong -> btrace $ "Received flood message with wrong signature from " ++ show sender
+				_ -> processCall
+	Target rt@(Routed ttl sender msgid tc sig) -> do
+		let processCall = giveAck from sender msgid >> case tc of
+			Nack nrt@(Routed _ receiver _ _ _) -> do
+				local <- isLocal receiver
+				if local
+					then do
+						-- We just try to resend the message 'as-is' maybe it will success now
+						processTarget nrt
+					else case decrementTTL rt of
+						Nothing -> return () -- Time's up, baby
+						Just rrt -> sendRouted (fmap Right rrt)
+			_ -> do
+				processTarget rt
+		case sig of
+			Nothing -> processCall
+			Just (_, sigStatus) -> case sigStatus of
+				SignatureWrong -> btrace $ "Received message with wrong signature from "++show sender++" for message "++msgid
+				_ -> processCall
+	Obscure rt@(Routed ttl receiver msgID obscData _) -> processObscure ttl receiver msgID obscData
+
+processFlood :: UserID -> MessageID -> FloodContent -> ExternalSignature -> ServerMonad ()
+processFlood sender _ (Channel cname cid ctitle users private) sig = unless (cname == anonymous) $ do
+	btrace $ "Received channel announcement for channel "++(show cname)++" ("++(show cid)++")"
+	isPrivate <- withChannelList $ query $ CL.isPrivate cname cid
+	-- TODO: a better way to distinct the cases and do the necessary calls may be considered
+	case isPrivate of
+		Just True -> case sig of -- here we rely on our stored information
+			Just (_, sigStatus) -> processChannel sender cname cid ctitle users True sigStatus
+			Nothing -> btrace $ "Rejected channel announcement w/o signature" -- announcements of private channels without signature are rejected
+		Just False -> processChannel sender cname cid ctitle users False SignatureOK -- for public channels signature does not matter
+		Nothing -> if private -- we have no information about the channel, so trust the message
+			then case sig of
+				Just (_, sigStatus) -> processChannel sender cname cid ctitle users private sigStatus
+				Nothing -> btrace $ "Rejected channel announcement w/o signature" -- announcements of private channels without signature are rejected
+			else processChannel sender cname cid ctitle users private SignatureOK -- for public channels signature does not matter
+processFlood sender _ (Join cname cid) sig = do
+	-- is channel private?
+	private <- withChannelList $ query $ CL.isPrivate cname cid
+	case private of
+		Just True -> do
+			-- decide whether one of our local users may be able to allow the join:
+			usersChannel <- withChannelList $ query $ CL.usersChannel cname cid
+			-- only request auth when sender is not yet in the channel:
+			unless (Set.member sender usersChannel) $ do
+				(localUsers, _) <- partitionLocals usersChannel
+				-- only when we have a user, request auth from him
+				unless (Set.null localUsers) $ do
+						let localUser = Set.findMin localUsers
+						btrace $ "Requesting authorization for channel "++(show cname)++" ("++(show cid)++") from local user "++(show localUser)
+						sendUser localUser (WantsAuth sender cname cid)
+		_ -> do
+			withChannelList $ manipulate $ CL.join sender cname cid
+			distributeChannelInformation
+	cl <- withChannelList $ query id
+	btrace $ show cl
+processFlood sender _ (Leave cname cid) sig = do
+	withChannelList $ manipulate $ CL.leave sender cname cid
+	distributeChannelInformation
+	cl <- withChannelList $ query id
+	btrace $ show cl
+processFlood _ _ (Anonymous text attachments msgTime _) sig = do
+	btrace $ "Received anonymous message with text '"++text++"' and time "++(show msgTime)
+	withPendingAnonymous $ manipulate $ PAnon.posted text msgTime
+	time <- curTime -- Mangling foreign timestamps
+	sendUserBroadcast (Receive anonymous (ChannelID "Anonymous" "Anonymous") Nothing text attachments time False)
+
+processChannelCallback :: UserID -> ChannelName -> ChannelID -> String -> [ UserID ] -> Bool -> (Certificate -> SignatureStatus) -> CertificateCallback
+processChannelCallback sender cname cid ctitle users private verify cert
+	= case Map.lookup sender cert of
+		Just rcert -> do
+			btrace $ "Got certificate for an older announcement, processing it ..."
+			processChannel sender cname cid ctitle users private (verify rcert)
+		Nothing -> return () -- This case should not happen
+
+processChannel' :: UserID -> ChannelName -> ChannelID -> String -> [ UserID ] -> Bool -> ServerMonad ()
+processChannel' sender cname cid ctitle users private = do
+	btrace $ "Processing channel announcement for channel " ++ show cname
+	-- process announcement
+	oldUsersChannel <- withChannelList $ query $ CL.usersChannel cname cid
+	-- we do only process the announcement in the following if
+	--  - we do not know the channel yet
+	--  - the channel is public
+	--  - the channel is private and the sender is member in the channel according to our previously stored info
+	if (Set.null oldUsersChannel) || (Set.member sender oldUsersChannel) || not private
+		then do
+			let usersChannel = Set.fromList users
+			btrace $ "Users in channel: "++(show usersChannel)
+			localUsers <- withLocalUserInfo $ query $ Map.assocs
+		 	-- update channels of local users in LocalUserInfo and check whether we have to request the channel key
+			when private $ mapM_ (joinUserLocally sender cname cid usersChannel) localUsers
+			-- update stored information about the channel
+			updateChannelInformation cname cid ctitle private usersChannel
+			-- query local users
+			localUsers <- withLocalUserInfo $ query $ Map.assocs -- work with up-to-date information
+			-- re-send leaves for all channels local users are no longer in
+			mapM_ (resendLeave cname cid usersChannel) localUsers
+	 		-- re-send JOINs for users that are not in the public channel but that want to be in it
+			unless private $ mapM_ (resendJoin cname cid usersChannel) localUsers
+			btrace $ "Channel announcement processed."
+		else btrace $ "Announcement for channel " ++ show cname ++ " rejected"
+
+processChannel :: UserID -> ChannelName -> ChannelID -> String -> [ UserID ] -> Bool -> SignatureStatus -> ServerMonad ()
+processChannel sender cname cid ctitle users private sigStatus = do
+	if private
+		then case sigStatus of
+			SignatureWrong -> btrace $ "Received channel announcement w/ wrong signature" -- channel is private, but signature of announcement is wrong, so drop it
+			CertificateMissing verify -> do -- Certificate is missing, hold back announcement
+				btrace $ "Got channel announcement for channel " ++ (show cname) ++ ", but I have no cert, deferring ..."
+				rl <- randomLocal
+				case rl of
+					Nothing -> btrace $ "Cannot request certificate to check private channel announcement (note that this is the fault of the shitty protocol)"
+					Just (localUser, _) -> requestCertificates localUser (Set.singleton sender) Map.empty
+						(processChannelCallback sender cname cid ctitle users private verify)
+			-- everything's fine, so process the announcement:
+			SignatureOK -> processChannel' sender cname cid ctitle users private
+		else processChannel' sender cname cid ctitle users private
+	cl <- withChannelList $ query id
+	btrace $ show cl
+
+processTarget :: Routed TargetContent ExternalSignature -> ServerMonad()
+processTarget rt@(Routed ttl sender msgid tc sig) = do
+	case tc of
+		GetCertificate for -> processGetCertificate rt for
+		Certificate receiver for cert -> processCertificate rt
+		GetKey receiver cname cid -> do
+			local <- isLocal receiver
+			if local
+				then do
+					processGetKey sender receiver cname cid
+				else case decrementTTL rt of
+					Nothing -> giveNack (fmap Right rt)
+					Just nrt -> sendRouted (fmap Right nrt)
+		Key receiver cname cid ctype key -> do
+			privkey <- withLocalUserInfo $ query $ privateKey receiver
+			case privkey of
+				-- User is local
+				Just rprivkey -> case rsaDecrypt rprivkey key of
+					Nothing -> berror $ "Couldn't decrypt channel key from "++show sender
+					Just rkey -> do
+						withChannelList $ manipulate $ CL.insert cname cid rkey
+						pendingMsgs <- withPendingKey $ PKey.purge cname cid
+						case pendingMsgs of
+							Just rpendingMsgs ->
+								mapM_ (processPendingKeyMessage rkey) rpendingMsgs
+							Nothing -> return ()
+				Nothing -> case decrementTTL rt of
+					Nothing -> giveNack (fmap Right rt)
+					Just nrt -> sendRouted (fmap Right nrt)
+		Message _ _ _ _ _ _ -> processMessageMessage rt
+
+processGetCertificate :: Routed TargetContent ExternalSignature -> UserID -> ServerMonad ()
+processGetCertificate rt for = do
+	btrace $ "Received GetCertificate for local user " ++ (show for) ++ " from " ++ (show (routedUserID rt))
+	-- Do we have the certificate?
+	qcert <- withCertificates (query $ Map.lookup for)
+	case qcert of
+		-- No? Then try to forward the request
+		Nothing -> case decrementTTL rt of		-- Can the message be further forwarded?
+			Nothing -> giveNack (fmap Right rt)	-- No? Then Nack it
+			Just nrt -> sendRouted (fmap Right nrt)	-- Yes? Great, send it to the requested user
+		-- Yes? Good, then we can give it to the requester
+		Just cert -> do
+			-- Export the certificate and send it to the requester
+			mid <- newMessageId
+			let cData = case GnuTLS.exportCertificate cert GnuTLS.X509FmtDer of
+				Left err -> error ("Internal GnuTLS error: "++show err)
+				Right c -> c
+			btrace $ "Having the certificate for " ++ (show for) ++ ", answering ..."
+			sendRouted (Routed 360 for mid (Certificate [routedUserID rt] for cData) (Right Nothing))
+
+processCertificate :: Routed TargetContent ExternalSignature -> ServerMonad ()
+processCertificate rt@(Routed ttl sender msgID (Certificate receivers for cert) sig) = rootCertificate >>= \root -> case (do
+	rcert <- GnuTLS.importCertificate cert GnuTLS.X509FmtDer
+	isIssuer <- GnuTLS.checkIssuer rcert root
+	unless isIssuer (fail "Certificate is not signed by root certificate.")
+	return rcert) of
+		Left err -> btrace $ "Received bad certificate for " ++ show for ++ ": " ++ show err
+		Right rcert -> do
+			btrace $ "Got the certificate from "++(show for)
+			withCertificates $ manipulate $ Map.insert for rcert
+			locals <- withLocalUserInfo $ query $ users
+			let remainRecvs = receivers \\ (Set.toList locals)
+			unless (List.null remainRecvs) $ sendRouted (Routed ttl sender msgID (Certificate remainRecvs for cert) (toInternal sig))
+			checkCertificateRequests for rcert
+
+processGetKeyCallback :: UserID -> PrivateKey -> ChannelName -> ChannelID -> UserID -> Word64 -> CertificateCallback
+processGetKeyCallback sender privkey cname cid receiver key certs = do
+	btrace $ "Key for channel "++(show cname)++" ("++(show cid)++") was requested from local user "++(show sender)++" ..."
+	msgID <- newMessageId
+	let cert = Map.lookup receiver certs
+	case cert of
+		Just rcert -> do
+			rand <- newRandom
+			btrace $ "Sending key from "++(show sender)++" to "++(show receiver)++" ..."
+			sendRouted (Routed 360 sender msgID (Key receiver cname cid CipherDES_CBC (rsaEncrypt rand rcert key)) (Left privkey))
+		Nothing -> do return () -- this case should not happen ...
+
+processGetKey :: UserID -> UserID -> ChannelName -> ChannelID -> ServerMonad ()
+processGetKey sender receiver cname cid = do
+	-- check whether we have the key
+	key <- withChannelList $ query $ CL.getKey receiver cname cid
+	case key of
+		Just rkey -> do
+			-- Yes, we have the key, so send him the key
+			privKey <- withLocalUserInfo $ query $ LocInf.privateKey receiver
+			case privKey of
+				Just rprivKey -> do
+					-- lookup certificate for receiver
+					(usersWOCert, usersWCert) <- seperateUsersWithCert [ sender ]
+					let callback = processGetKeyCallback receiver rprivKey cname cid sender rkey
+					if Set.null usersWOCert
+						-- we have already the certificate
+						then do
+							callback usersWCert
+						-- we do not have it, so start a request
+						else do
+							requestCertificates receiver usersWOCert usersWCert callback
+				Nothing -> return () -- eh, should not happen
+		Nothing -> do
+			-- we do not have the key?? that's weird but we just don't process the request then
+			return ()
+
+processMessageMessage :: Routed TargetContent ExternalSignature -> ServerMonad ()
+processMessageMessage rt@(Routed ttl sender msgid msg@(Message receivers cname cid cont time delay) sig) = do
+	btrace("Processing message ...")
+	-- query users in channel
+	usersChannel <- withChannelList $ query $ CL.usersChannel cname cid
+	-- is sender member of the channel?
+	when (Set.member sender usersChannel) $ do -- yes
+		btrace $ "Partitioning users ..."
+		-- partition receivers in local and non-local ones
+		btrace $ "Receivers: "++(show receivers)
+		(localRecv, nonLocalRecv) <- partitionLocals (Set.fromList receivers)
+		btrace $ show localRecv
+		btrace $ show nonLocalRecv
+		-- forward message to any remaining non-local users
+		btrace $ "Forwarding to remaining users ..."
+		unless (Set.null nonLocalRecv) $ do
+				let rt = (Routed ttl sender msgid (Message (Set.toList nonLocalRecv) cname cid cont time (delay + 1)) (toInternal sig))
+				case decrementTTL rt of
+					Nothing -> giveNack rt
+					Just nrt -> sendRouted nrt
+		-- calculate time offsets
+		currentTime <- curTime
+		offset <- withTimeOffsets $ query $ Map.lookup sender
+		delayed <- case offset of
+			Just (locTime, forTime) -> let offset = abs (diffUTCTime locTime forTime); msgOffset = abs (diffUTCTime currentTime time) in
+				if msgOffset < offset
+					then (withTimeOffsets $ manipulate $ Map.insert sender (currentTime, time)) >> return False
+					else return (msgOffset > offset + 10) -- 8 secs
+			Nothing -> do
+				withTimeOffsets $ manipulate $ Map.insert sender (currentTime, time)
+				return (False) -- For the first message we cannot say if it got delayed
+		btrace $ "Forwarding to local users ..."
+		offset' <- withTimeOffsets $ query $ Map.lookup sender
+		let correctedTime = case offset' of -- correct timestamp
+			Just (locTime, forTime) -> addUTCTime (diffUTCTime locTime forTime) time --currentTime
+			Nothing                 -> currentTime
+		mapM_ (processMessageForLocalUser sender correctedTime delayed msg) (Set.toList localRecv)
+
+processMessageForLocalUser :: UserID -> UTCTime -> Bool -> TargetContent -> UserID -> ServerMonad ()
+processMessageForLocalUser sender time delayed msg@(Message _ cname cid cont _ delay) receiver = do
+	case cont of
+		EncryptedMessage text attachments -> do
+			havingKey <- (withChannelList $ query $ keyKnown cname cid)
+			if havingKey
+				-- we have the key, try to decrypt the message:
+				then do
+					key <- withChannelList $ query $ getKey receiver cname cid
+					case key of
+						Just rkey -> case decryptMessageContent rkey text attachments of
+							Nothing -> berror $ "Failed to decrypt message from "++show sender
+							Just (decText,decAttachments) -> sendUser receiver (Receive cname cid (Just sender) decText decAttachments time delayed)
+						Nothing -> return () -- somehow we are not allowed to retrieve the key ...
+				-- we do not have the key, so defer the message until we have the key
+				else withPendingKey $ manipulate $ PKey.insert cname cid (Right (sender, msg, time, delayed))
+		UnencryptedMessage text attachments -> sendUser receiver (Receive cname cid (Just sender) text attachments time delayed)
+
+decryptMessageContent :: Word64 -> Encrypted String -> [ EncryptedAttachment ] -> Maybe (String, [ Attachment ])
+decryptMessageContent key text a = do
+	rtext <- decrypt key text
+	rattach <- mapM (decryptAttachment key) a
+	return (rtext,rattach)
+
+processObscure :: TTL -> UserID -> MessageID -> RSAEncrypted String -> ServerMonad ()
+processObscure ttl receiver msgID obscData = do
+	-- is obscure addressed to local user?
+	privkey <- withLocalUserInfo $ query $ LocInf.privateKey receiver
+	case privkey of
+		-- Yes, it is, so process it
+		Just rprivkey -> case rsaDecrypt rprivkey obscData of -- decrypt content
+			Nothing -> berror $ "Failed to decrypt obscure message"
+			Just decrypted -> case xmlParse' "ObscureMessage" decrypted >>= parseInnerMessage of
+				Left err -> berror $ "Failed to parse inner message: " ++ err ++ " failed message: "++decrypted
+				Right msg -> case msg of
+					Left (receiver, innerData) -> do
+						msgID <- newMessageId
+						sendObscure (Routed 32 receiver msgID innerData ())
+					Right (time, text, attachments) -> do
+						sendAnonymousMessage 360 text attachments time
+		-- No
+		Nothing -> do
+			let rt = Routed ttl receiver msgID obscData ()
+			-- forward message
+			case decrementTTL rt of
+				Nothing -> return () -- It's over here
+				Just nrt -> sendObscure rt
+
+-- ----------------------------------
+-- - PROCESSING HELPER FUNCTIONS - --
+-- ----------------------------------
+
+-- | Request the shared key for a private channel without given two users, one that requests the key, one that has the key
+requestPrivChanKey :: ChannelName -> ChannelID -> ServerMonad ()
+requestPrivChanKey cname cid = do
+	btrace $ "Requesting key for private channel " ++ show cname ++ " (" ++ show cid ++ "):"
+	channelUsers <- withChannelList $ query $ CL.usersChannel cname cid
+	btrace $ "Users in channel:"
+	btrace $ show channelUsers
+	(localUsers, nonLocalUsers) <- partitionLocals channelUsers
+	btrace $ show localUsers ++ ", " ++ show nonLocalUsers
+	unless (Set.null localUsers || Set.null nonLocalUsers) $ do
+		let sender = Set.findMin localUsers
+		let receiver = Set.findMin nonLocalUsers
+		privKey <- withLocalUserInfo $ query $ privateKey sender
+		case privKey of
+			Just rprivKey -> requestPrivChanKey' cname cid receiver sender rprivKey
+			Nothing -> return () -- this case should not happen
+
+-- | Request the shared key for a private channel
+requestPrivChanKey' :: ChannelName -> ChannelID -> UserID -> UserID -> PrivateKey -> ServerMonad ()
+requestPrivChanKey' cname cid announceSender user privKey = do
+	btrace $ "Requesting key for private channel " ++ show cname ++ " (" ++ show cid ++ ") ..."
+	-- check whether channel is private (just a check)
+	isPrivate <- withChannelList $ query $ CL.isPrivate cname cid
+	-- check whether we have to request the key
+	havingKey <- withChannelList $ query $ CL.keyKnown cname cid
+	case isPrivate of
+		Just True -> unless havingKey $ do
+			time <- curTime
+			msgID <- newMessageId
+			withChannelList $ manipulate $ CL.request time cname cid
+			sendRouted (Routed 360 user msgID (GetKey announceSender cname cid) (Left privKey))
+		Nothing -> return ()
+
+joinUserLocally :: UserID -> ChannelName -> ChannelID -> Set.Set UserID -> (UserID, SingleUserInfo) -> ServerMonad ()
+joinUserLocally sender cname cid cusers (user, (channels, pk, h))
+	= when (Set.member user cusers && not (Set.member (cname, cid) channels)) $ do
+		withLocalUserInfo $ manipulate $ Map.insert user (Set.insert (cname, cid) channels, pk, h)
+		requestPrivChanKey' cname cid sender user pk
+
+joinUser :: UserID -> PrivateKey -> ChannelName -> ChannelID -> ServerMonad ()
+joinUser user privkey cname cid = do
+	msgID <- newMessageId
+	sendMessageBroadcast (Flood (Routed 360 user msgID (Join cname cid) (Left privkey)))
+
+leaveUser :: UserID -> PrivateKey -> ChannelName -> ChannelID -> ServerMonad ()
+leaveUser user privKey cname cid = do
+	btrace $ "Sending leave for user " ++ show user ++ " in " ++ show cname ++ " " ++ show cid
+	msgID <- newMessageId
+	sendMessageBroadcast (Flood (Routed 360 user msgID (Leave cname cid) (Left privKey)))
+
+resendJoin :: ChannelName -> ChannelID -> Set.Set UserID -> (UserID, SingleUserInfo) -> ServerMonad ()
+resendJoin cname cid users (user, (channels, privKey, _))
+	= when ((Set.member (cname, cid) channels) && not (Set.member user users)) $ joinUser user privKey cname cid
+
+resendLeave :: ChannelName -> ChannelID -> Set.Set UserID -> (UserID, SingleUserInfo) -> ServerMonad ()
+resendLeave cname cid users (user, (channels, privKey, _))
+	= when ((Set.member user users) && not (Set.member (cname, cid) channels)) $ leaveUser user privKey cname cid
+
+announceChannel :: (ChannelName, ChannelID, String, Set.Set UserID, Bool) -> ServerMonad ()
+announceChannel (cname, cid, desc, localUsers, private) = unless (Set.null localUsers) $ do
+	let localUser = Set.findMin localUsers
+	channelUsers <- withChannelList $ query $ CL.usersChannel cname cid
+	privkey <- withLocalUserInfo $ query $ privateKey localUser
+	msgID <- newMessageId
+	case privkey of
+		Just rprivkey -> sendMessageBroadcast (Flood (Routed 48 localUser msgID (Channel cname cid desc (Set.toList channelUsers) private) (Left rprivkey)))
+		Nothing -> return () -- This should not happen
+
+mergeChannel :: ChannelName -> ChannelID -> ChannelID -> String -> Set.Set UserID -> ServerMonad ()
+mergeChannel cname ocid ncid ctitle users = do
+	(nlocalUsers, _) <- partitionLocals users
+	-- announce merged channel
+	announceChannel (cname, ncid, ctitle, nlocalUsers, False)
+	-- update LocalUserInfo with merged channel id so that we are consistent again
+	forM_ nlocalUsers (\user -> do
+		userInfo <- withLocalUserInfo $ query $ Map.lookup user
+		case userInfo of
+			Just (channels, pk, h) -> withLocalUserInfo $ manipulate $ Map.insert user (Set.insert (cname, ncid) (Set.delete (cname, ocid) channels), pk, h)
+			Nothing -> return ()
+		)
+
+updateChannelInformation :: ChannelName -> ChannelID -> String -> Bool -> Set.Set UserID -> ServerMonad ()
+updateChannelInformation cname cid ctitle private users = do
+	time <- curTime
+	oldChannelInfo <- withChannelList $ query $ CL.lookupPublic cname
+	knownUsers <- withRoutingTable $ query $ RT.userList
+	localUsers <- withLocalUserInfo $ query $ LocInf.users
+	let allUsers = Set.union knownUsers localUsers
+	let remUsers = Set.filter (\user -> Set.member user allUsers) users
+	withChannelList $ manipulate $ CL.update time cname cid ctitle private (Set.toList remUsers)
+	distributeChannelInformation
+	-- resend announcements for public channels that we have merged:
+	case oldChannelInfo of
+		Just (ocid, _, ousers) -> when (not private && (ocid /= cid)) $ do
+			-- query merged channel information
+			newChannelInfo <- withChannelList $ query $ CL.lookupPublic cname
+			case newChannelInfo of
+				Just (ncid, nctitle, nusers) -> mergeChannel cname ocid ncid nctitle nusers
+				Nothing -> return ()
+		Nothing -> return ()
+
+sendAnonymousMessage :: TTL -> String -> [ Attachment ] -> UTCTime -> ServerMonad ()
+sendAnonymousMessage ttl text attachments time = do
+	rl <- randomLocal
+	case rl of
+		Nothing -> btrace $ "Can't send anonymous message as we do not have local users (note that this is because of the fucked up protocol)"
+		Just (sender, privkey) -> do
+			msgID <- newMessageId
+			sendMessageBroadcast (Flood (Routed ttl sender msgID (Anonymous text attachments time 0) (Left privkey)))
+
+sendMsgToChannel :: UserID -> PrivateKey -> ChannelName -> ChannelID -> [ UserID ] -> String -> [ Attachment ] -> ServerMonad ()
+sendMsgToChannel sender privKey cname cid receivers text attachments = do
+	time <- curTime
+	msgID <- newMessageId
+	-- check whether we have to encrypt the content or not
+	isPrivate <- withChannelList $ query $ CL.isPrivate cname cid
+	-- we may need the unencrypted message in both cases, so we define it here:
+	let unencMsg = Message receivers cname cid (UnencryptedMessage text attachments) time 0
+	case isPrivate of
+		Just True -> do
+			key <- withChannelList $ query $ CL.getKey sender cname cid
+			case key of
+				Just rkey -> do
+					-- create random initial vector
+					iv <- withRandom (\gen -> let (res,ngen) = randomR (1,2^64 - 1) gen in (ngen,res))
+					-- encrypt the message
+					let content = EncryptedMessage (encrypt rkey (fromInteger iv) text) (map (encryptAttachment rkey (fromInteger iv)) attachments)
+					sendRouted (Routed 360 sender msgID (Message receivers cname cid content time 0) (Left privKey))
+				Nothing -> withPendingKey $ manipulate $ PKey.insert cname cid (Left (sender, privKey, unencMsg))
+		Just False -> sendRouted (Routed 360 sender msgID unencMsg (Left privKey))
+		Nothing -> return ()
+
+requestCertificate :: UserID -> UserID -> ServerMonad ()
+requestCertificate sender for = do
+	btrace $ "Requesting certificate for "++(show for)++" from local user "++(show sender)
+	msgID <- newMessageId
+	-- send GetCertificate request
+	sendRouted (Routed 360 sender msgID (GetCertificate for) (Right Nothing))
+
+requestCertificates :: UserID -> Set.Set UserID -> Map UserID Certificate -> CertificateCallback -> ServerMonad ()
+requestCertificates sender users certs cb = do
+	-- add request to the certificate request list
+	withCertificateRequests $ manipulate $ (++[ (users, certs, cb) ])
+	-- request certificates for users we do not have yet one
+	mapM_ (requestCertificate sender) (Set.toList users)
+
+processCertificateRequest :: UserID -> Certificate -> CertificateRequest -> CertificateRequest
+processCertificateRequest for cert (users, usersWithCert, cb)
+	= (users', usersWithCert', cb)
+	where
+		usersWithCert' = if (Set.member for users) then Map.insert for cert usersWithCert else usersWithCert
+		users'         = Set.delete for users
+
+checkCertificateRequests' :: [ CertificateRequest ] -> ([ CertificateRequest ], [ ServerMonad () ])
+checkCertificateRequests' requests = (snd requests', actions)
+	where
+		requests' = List.partition (\(users, _, _) -> Set.null users) requests
+		actions   = map (\(_, certs, cb) -> (cb certs)) (fst requests')
+
+checkCertificateRequests :: UserID -> Certificate -> ServerMonad ()
+checkCertificateRequests for cert = do
+	-- fullfil all requests that need the given cert
+	withCertificateRequests $ manipulate $ (map (processCertificateRequest for cert))
+	-- check whether some requests are no longer waiting for any certificates
+	actions <- withCertificateRequests $ checkCertificateRequests'
+	-- call their callbacks
+	mapM_ id actions
+
+processPendingKeyMessage :: Word64 -> PendingKeyMessage -> ServerMonad ()
+processPendingKeyMessage key msg = do
+	btrace $ "Processing pending key message ..."
+	case msg of
+		Left (sender, privKey, tc@(Message _ _ _ (UnencryptedMessage text a) _ _)) -> do
+			btrace $ "Is local message to be sent ..."
+			time <- curTime
+			msgID <- newMessageId
+			-- create random initial vector
+			iv <- withRandom (\gen -> let (res,ngen) = randomR (1,2^64 - 1) gen in (ngen,res))
+			sendRouted (Routed 360 sender msgID (tc { messageContent = EncryptedMessage (encrypt key (fromInteger iv) text) (map (encryptAttachment key (fromInteger iv)) a) }) (Left privKey))
+		Right (sender, (Message receivers cname cid (EncryptedMessage text attachments) _ _), time, delayed) -> do
+			btrace $ "Is foreign message to be decrypted ..."
+			case decryptMessageContent key text attachments of
+				Nothing -> berror $ "Failed to decrypt message from "++show sender
+				Just (decText, decAttachments) -> mapM_ ((flip sendUser) (Receive cname cid (Just sender) decText decAttachments time delayed)) receivers
+
+obscureMessage' :: RandomGen g => g -> ObscureMessage -> (UserID, Certificate) -> ObscureMessage
+obscureMessage' gen msg (user, cert) = Right (user, encryptedMsg)
+	where
+		nestedMsg    = case msg of
+		                   Left (text, attachments, time)
+		                       -> generateMessage' $ genRootElem "chat-message" (genAnonymous False Nothing Nothing text attachments time) True Nothing 360 (Right Nothing)
+		                   Right (receiver, RSAEncrypted content)
+		                       -> generateMessage' $ genRootElem "chat-message" (genObscure receiver Nothing content) False Nothing 32 (Right Nothing)
+		encryptedMsg = rsaEncrypt gen cert nestedMsg
+
+obscureMessage :: PendingAnonymousMessage -> [ (UserID, Certificate) ] -> ServerMonad (ObscureMessage)
+obscureMessage (PendingAnonymousMessage ttl _ text attachments time) users = do
+	btrace $ "Creating obscure messages ..."
+	rand <- newRandom
+	let (_, obscMsg) = foldl (\(rand', msg) usr -> let (g1, g2) = System.Random.split rand' in (g2, obscureMessage' g1 msg usr)) (rand, Left (text, attachments, time)) users
+	return (obscMsg)
+
+sendObscure :: Routed (RSAEncrypted String) () -> ServerMonad ()
+sendObscure obscMsg@(Routed ttl receiver msgID obscData _) = do
+	btrace $ "Got an obscure for "++(show receiver)++" ..."
+	-- route obscure message:
+	localUsers <- withLocalUserInfo $ query $ users
+	if Set.member receiver localUsers
+		then do
+			btrace $ "Obscure for local user, processing ..."
+			processObscure ttl receiver msgID obscData
+			btrace $ "Obscure processed."
+		else do
+			btrace $ "Obscure for foreign user, forwarding ..."
+			-- query routing table
+			table <- withRoutingTable $ query $ id
+			-- lookup routes,
+			-- we don't care about errors here, if message could not be routed, we or the sender
+			-- will try it later (ensured through pending structure)
+			let (addrs, _) = route table obscMsg
+			mapM_ (\(addr, msg) -> sendMessage addr (Obscure msg)) (Map.assocs addrs)
+			btrace $ "Obscure forwarded."
+
+sendAnonymousCallback :: PendingAnonymousMessage -> CertificateCallback
+sendAnonymousCallback paMsg@(PendingAnonymousMessage ttl _ text attachments mtime) users = do
+	-- do obscuring here ...
+	btrace $ "Obscuring message ..."
+	localUsers <- withLocalUserInfo $ query $ LocInf.users
+	let (lu, nlu) = List.partition (\(u, _) -> Set.member u localUsers) (Map.assocs users)
+	-- lu and nlu are still sorted
+	lu'  <- withRandom (\gen -> shuffle gen lu)  -- shuffle local users
+	nlu' <- withRandom (\gen -> shuffle gen nlu) -- shuffle remote users
+	let (start, nlu'') = if List.null nlu'
+		then ([],          [])
+		else ([head nlu'], tail nlu')
+
+	restPath <- withRandom (\gen -> shuffle gen (lu' ++ nlu''))
+	let path = restPath ++ start
+	btrace $ "Chosen path: " ++ (show $ reverse $ path)
+	obscMsg <- obscureMessage paMsg path
+	case obscMsg of
+		Right (receiver, content) -> do
+			msgID <- newMessageId
+			-- send the obscure message
+			sendObscure (Routed ttl receiver msgID content ())
+			-- add it to our pending structure so we can observe whether it will be posted or not
+			time <- curTime
+			withPendingAnonymous $ manipulate $ PAnon.insert time paMsg
+		Left (_, _, _) -> return ()
+
+sendAnonymous :: PendingAnonymousMessage -> ServerMonad ()
+sendAnonymous paMsg@(PendingAnonymousMessage ttl sender text attachments time) = do
+	users <- randomUsers 5
+	if (length users) > 2
+		then do
+			(usersWOCert, usersWCert) <- seperateUsersWithCert users
+			if (Set.null usersWOCert)
+				then do
+					btrace $ "Having all certificates to obscure message so I'm just doing it ..."
+					sendAnonymousCallback paMsg usersWCert
+				else do
+					btrace $ "Not having all certificates, starting requests ..."
+					-- query one local user for certificate requests
+					rl <- randomLocal
+					case rl of
+						Nothing -> berror $ "(sendAnonymous): This should not happen"
+						Just (sender, _) -> requestCertificates sender usersWOCert usersWCert (sendAnonymousCallback paMsg)
+		else sendUser sender (ErrGeneral MessageWarning "Message not delivered"
+			$ "Sorry, I'm omitting your message. I'm unable to send it anonymously, because there are not enough users on the network.\n\n"
+			++ "I need at least three users to obscure the origin of a message.")
+
+giveAck :: SockAddr -> UserID -> MessageID -> ServerMonad ()
+giveAck to for msgid = sendMessage to (Ack for msgid)
+
+giveNack :: Routed TargetContent InternalSignature -> ServerMonad ()
+giveNack (Routed _ _ _ (Nack _) _) = return () -- Don't give Nacks to Nacks
+giveNack (Routed _ sender _ (Message receivers cname cid (EncryptedMessage enc attachments) time _) (Left key)) = do
+	key <- withChannelList $ query $ CL.getKey sender cname cid
+	case key of
+		Just rkey -> case decryptMessageContent rkey enc attachments of
+			Just (rtext,rattachments) -> sendUser sender (ErrNotDelivered receivers cname cid rtext rattachments time)
+			Nothing -> berror $ "Failed to decrypt message from "++show sender
+		Nothing -> return () -- This case should not happen
+giveNack (Routed _ sender _ (Message receivers cname cid (UnencryptedMessage text attachments) time _) (Left key)) = sendUser sender (ErrNotDelivered receivers cname cid text attachments time)
+giveNack (Routed _ sender _ tc (Left key)) = do
+--	is this really of interest for the user? undelivered chatmessages
+--	are reported elsewhere; besides, the message won't help the user at all
+--	sendUser sender (ErrGeneral "Some message could not be routed")
+	btrace $ "Some message could not be routed:"
+	btrace $ show tc
+giveNack rt@(Routed _ _ _ _ (Right sig)) = do
+	rl <- randomLocal
+	case rl of
+		Nothing -> btrace $ "Can't give NACK because there's no local user (blame the stupid protocol!)"
+		Just (sender,privkey) -> do
+			msgid <- newMessageId
+			sendRouted (Routed 360 sender msgid (Nack (rt {routedSignature = sig})) (Left privkey))
+
+-- ----------------------------
+-- - SENDING HELPER FUNCTIONS -
+-- ----------------------------
+
+resend :: SockAddr -> Routed TargetContent InternalSignature -> Set.Set SockAddr -> UTCTime -> ServerMonad ()
+resend addr rt tried received = do
+	now <- curTime
+	withPendingAck $ manipulate $ PAck.reinsert received now rt addr tried
+	sendMessage addr (Target rt)
+
+sendRoutedWithStrategy :: RoutingStrategy rs => rs -> Routed TargetContent InternalSignature -> ServerMonad ()
+sendRoutedWithStrategy strat routed = do
+	let (addrs,noroute) = route strat routed
+	mapM_ (\(addr,tc) -> sendMessage addr (Target tc)) (Map.toList addrs)
+	time <- curTime
+	withPendingAck $ manipulate $ flip (foldl (\pa (addr,rt) -> PAck.insert time rt addr pa)) (Map.assocs addrs)
+	case noroute of
+		Nothing -> return () -- Each message could be routed
+		Just nackcont -> giveNack nackcont
+
+sendRouted :: Routed TargetContent InternalSignature -> ServerMonad ()
+sendRouted routed = do
+	table <- withRoutingTable $ query id
+	sendRoutedWithStrategy table routed
+
+-- --------------------------
+-- - OTHER HELPER FUNCTIONS -
+-- --------------------------
+
+randomLocal :: ServerMonad (Maybe (UserID,GnuTLS.PrivateKey))
+randomLocal = withLocalUserInfo (query (fmap (\(user,(chans,key,handle)) -> (user,key)).listToMaybe.(Map.assocs)))
+
+randomUsers :: Int -> ServerMonad ([ UserID ])
+randomUsers n = do
+	-- query all known users from routing table and local user info
+	users <- withRoutingTable $ query $ RT.userList
+	localUsers <- withLocalUserInfo $ query $ LocInf.users
+	-- shuffle users and return n of them
+	withRandom (\gen -> shuffle gen (Set.toList (Set.union users localUsers))) >>= return.(take n)
+
+-- | Takes a list of 'UserID's and splits them into a set lacking a certificate in "CertificateList" and a map of 'UserID's and 'Certificate's
+seperateUsersWithCert :: [ UserID ] -> ServerMonad (Set.Set UserID, Map UserID Certificate)
+seperateUsersWithCert users = do
+	usersWithCert <- withCertificates $ query $ Map.filterWithKey (\user _ -> user `elem` users)
+	let usersWOCert = users \\ (Map.keys usersWithCert)
+	return (Set.fromList usersWOCert, usersWithCert)
+
+distributeChannelInformation :: ServerMonad ()
+distributeChannelInformation = do
+	mp <- withChannelList $ query $ CL.channelMap
+	users <- withRoutingTable $ query $ userList
+	localUsers <- withLocalUserInfo $ query $ LocInf.users
+	let rmp = Map.insert (mkChannelName "Anonymous", ChannelID "Anonymous" "Anonymous") ("Anonymous", False, Set.union users localUsers) mp
+	sendUserBroadcast (AllChans rmp)
+
+shuffle :: RandomGen g => g -> [a] -> (g, [a])
+shuffle gen list = shuffle' gen (length list) list
+
+shuffle' :: RandomGen g => g -> Int -> [a] -> (g, [a])
+shuffle' gen _ []  = (gen, [])
+shuffle' gen len list = let
+	(index, gen')   = randomR (0, len - 1) gen
+	(left, r:right) = splitAt index list
+	(gen'', rest)   = shuffle' gen' (len - 1) (left ++ right)
+	in (gen'', r:rest)
+
+-- | An Array of (randomly chosen) hellos
+hellos :: Array Int String
+hellos = listArray (1, 10)
+	[ "Deine Muddi!"  -- it's classical...
+	, "Haskell rules" -- :)
+	, "Hi, this is Barracuda" -- standard
+	, "Greetings from Barracuda"
+	, "Debugging sucks..."
+	, "Barracuda > Palaver ;)"  -- being offensive is always a good thing ;)
+	, "Barracuda > AdBee ;)"
+	, "Barracuda > MAdchat ;)"
+	, "May the force be with you (if you're using Barracuda)"
+	, "ping"
+	]
+
diff --git a/Barracuda/GUI.hs b/Barracuda/GUI.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI.hs
@@ -0,0 +1,194 @@
+-- |
+-- Maintainer: Oliver Mielentz, Henning Guenther
+--
+-- A module assembling the single gui modules to one user interface.
+module Barracuda.GUI (
+	guiNew
+) where
+
+
+import Data.IORef
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.ModelView as New
+import Barracuda.GUI.CertificateLoader
+import Barracuda.GUI.ChannelCreator
+import Barracuda.GUI.ChannelList
+import Barracuda.GUI.ChannelManager
+import Barracuda.GUI.DownloadManager
+import Barracuda.GUI.UserList
+import Barracuda.GUI.InputField
+import Barracuda.GUI.ChatView
+import Data.List as List
+import Data.Map as Map
+import Data.Set as Set
+import Data.Time.Clock
+import Control.Concurrent
+import Control.Concurrent.Chan
+import Control.Concurrent.MVar
+import Barracuda.GUI.ServerInterface
+import Network.AdHoc.Channel
+import Network.AdHoc.UserID
+import Network.AdHoc.Message
+import Network.GnuTLS.X509
+import System.Environment
+import Data.ByteString (pack)
+import Data.ByteString.Char8 (unpack)
+
+-- | Spawns a new user interface.
+guiNew :: GUI
+guiNew send = do
+	precv <- newIORef (const $ return ())
+	win <- windowNew
+	windowSetDefaultSize win 340 300
+	cl <- loaderNew (\cert key -> case certificateGetUserID cert of
+		Nothing -> error "Think of something here"
+		Just name -> do
+			f <- guiNew' name send
+			writeIORef precv f
+			send (SetUser name cert key)
+			widgetDestroy win
+		)
+	win `containerAdd` (loaderGetWidget cl)
+	widgetShowAll win
+	return (\msg -> do
+		f <- readIORef precv
+		f msg)
+
+guiNew' :: UserID -> GUI
+guiNew' user send = do
+	win <- windowNew
+	let goldenRatio = (1 + sqrt (5 :: Double)) / (fromInteger 2)
+	let height = 500
+	windowSetDefaultSize win (round (goldenRatio * (fromInteger.toInteger) height)) height
+	win `windowSetTitle` ("Barracuda - "++show user)
+	manager <- channelManagerNew
+		(\attach -> do
+			dm <- downloadManagerNew attach
+			win <- windowNew
+			win `containerAdd` (downloadManagerGetWidget dm)
+			widgetShowAll win)
+		(\cname cid user -> send (Authorize user cname cid))
+		user >>= newMVar
+
+	-- generates the UserList Widget
+	userList <- frameNew
+	userl <- userListNew
+
+	userlabel <- labelNew (Just "<b>Users in active Channel</b>")
+	labelSetUseMarkup userlabel True
+	frameSetLabelWidget userList userlabel
+	userList `containerAdd` (userListGetWidget userl)
+
+	-- generates the ChannelList Widget
+	channel <- channelListNew
+	channelList <- frameNew
+
+	channellabel <- labelNew (Just "<b>Channels</b>")
+	labelSetUseMarkup channellabel True
+	frameSetLabelWidget channelList channellabel
+	channelList `containerAdd` (channelListGetWidget channel)
+
+	-- generates the InputField
+	input <- inputFieldNew
+	input `onSend` (\txt attach -> do
+		cm <- readMVar manager
+		case channelManagerChannel cm of
+			Just (cname,cid,True) -> send (SendMsg cname cid txt attach)
+			_ -> return ()
+		inputFieldClear input)
+
+		
+
+	-- place the widgets
+	hPan <- hPanedNew
+	vbox <- vBoxNew False 0
+	vPan_lists <- vPanedNew
+	hPan `containerAdd` vPan_lists
+	hPan `containerAdd` vbox
+	chatviewframe <- frameNew
+	chatviewlabel <- labelNew (Just "<b>Chat</b>")
+	let changeMainWidget wid = do
+		child <- binGetChild chatviewframe
+		case child of
+			Nothing -> return ()
+			Just rchild -> containerRemove chatviewframe rchild
+		containerAdd chatviewframe wid
+		widgetShowAll chatviewframe
+	let update cm = channelManagerCheckState cm changeMainWidget
+	let updateUserList cm = userListSetUsers userl (channelManagerUsers cm)
+	channel `onChannelSelect` (\chan -> modifyMVar_ manager (\cm -> do
+		let ncm = channelManagerSelect (channelName chan) (channelID chan) cm
+		nncm <- channelManagerCheckState ncm changeMainWidget
+		updateUserList nncm
+		chatViewScroll $ view nncm
+		return nncm))
+	channel `onChannelJoin` (\chan -> send (WantJoin (channelName chan) (channelID chan)))
+	channel `onChannelLeave` (\chan -> send (WantLeave (channelName chan) (channelID chan)))
+	channel `onChannelCreate` (do
+		dialog <- windowNew
+		windowSetTitle dialog "Create new channel"
+		creat <- channelCreatorNew
+		dialog `set`
+			[windowTransientFor:=win
+			,windowModal:=True
+			,windowAllowGrow:=False]
+		dialog `containerAdd` (channelCreatorGetWidget creat)
+		creat `channelCreatorOnEnter` (\name descr priv -> do
+			send (CreateChannel (mkChannelName name) descr (if priv then Just (Set.empty) else Nothing))
+			widgetDestroy dialog)
+		widgetShowAll dialog
+		)
+
+	labelSetUseMarkup chatviewlabel True
+	frameSetLabelWidget chatviewframe chatviewlabel
+	boxPackStart vbox chatviewframe PackGrow 0
+	boxPackStart vbox (inputFieldGetWidget input) PackNatural 0
+
+	set vPan_lists [ containerChild := frame 
+		| frame <- [ channelList, userList ] ]
+	vPan_lists `set` [panedPosition := 300]
+	win `containerAdd` hPan
+	withMVar manager update
+	win `onDestroy` (do
+		send CMClose
+		modifyMVar_ manager (return.channelManagerNoState)
+		)
+	widgetShowAll win
+
+	let receive msg = postGUIAsync $ case msg of
+		AllChans mp -> do
+			modifyMVar_ manager $ \cm -> update $ channelManagerUpdate mp cm
+			cm <- readMVar manager
+			channelListSetChannels channel (List.map
+				(\((cname,cid),(desc,priv,users)) -> Chan
+					(show cname ++ (case desc of
+						"" -> ""
+						_  -> " (" ++ desc ++ ")"))
+					cname
+					cid
+					priv
+					(Set.member (channelManagerUsername cm) users)) (Map.assocs mp)) (fmap (\(cname,cid,_)-> (cname,cid)) $ channelManagerChannel cm)
+			updateUserList cm
+		Receive cname cid sender msg attach time delayed -> modifyMVar_ manager $ channelManagerPost cname cid time sender msg attach delayed
+		WantsAuth user cname cid -> do
+			time <- getCurrentTime
+			modifyMVar_ manager $ channelManagerWantsAuth cname cid time user
+		ErrGeneral level title str -> do
+			dia <- messageDialogNew (Just win) [] level ButtonsOk str
+			windowSetTitle dia title
+			dialogRun dia
+			widgetDestroy dia
+		ErrNotDelivered user cname cid msg _ time -> modifyMVar_ manager $
+			channelManagerError cname cid time ((constructAnd $ fmap show user) ++ " didn't get your message.")
+		_ -> print msg 
+	return receive
+
+constructAnd :: [String] -> String
+constructAnd = constructAnd' ""
+	where
+	constructAnd' :: String -> [String] -> String
+	constructAnd' str [] = str
+	constructAnd' str (x:xs)
+		| List.null str  = constructAnd' x xs
+		| List.null xs   = str++" and "++x
+		| otherwise      = constructAnd' (str++", "++x) xs
diff --git a/Barracuda/GUI/CertificateLoader.hs b/Barracuda/GUI/CertificateLoader.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI/CertificateLoader.hs
@@ -0,0 +1,319 @@
+{-# LANGUAGE RecursiveDo #-}
+-- | Maintainer: Henning Guenther
+-- This module contains a GUI widget used to load certificates and matching private keys.
+module Barracuda.GUI.CertificateLoader
+	(CertificateLoader
+	,PrivateKeyLoader
+	,Loader
+	,certificateLoaderNew
+	,privateKeyLoaderNew
+	,loaderNew
+	,certificateLoaderGet
+	,privateKeyLoaderGet
+	,certificateKeyMatch 
+	,loaderGetWidget
+	,certificateGetUserID
+	) where
+
+import Barracuda.Utils
+import Control.Monad.Fix (mfix)
+import Data.IORef
+import Graphics.UI.Gtk
+import qualified Data.ByteString as BS
+import Data.ByteString.Char8 (unpack)
+import System.Directory (doesFileExist)
+import Network.GnuTLS (importCertificate,importPrivateKey,getDnByOid
+	,oidPKCS9Email,X509CertificateFormat(..),Certificate
+	,PrivateKey,certificateGetKeyId,privateKeyGetKeyId)
+import Network.AdHoc.UserID
+
+-- | Loader widget for certificates.
+data CertificateLoader = CertLoader FileChooserButton (IORef (Maybe String -> IO ()))
+
+-- | Loader widget for private keys.
+data PrivateKeyLoader  = PrivLoader FileChooserButton (IORef (IO ()))
+
+data LoaderStatus = LoadStat HBox Image Label
+
+-- | A loader widget including a 'CertificateLoader' and a 'PrivateKeyLoader'.
+data Loader = Loader Table (IORef (Certificate -> PrivateKey -> IO ()))
+
+contentFilterNew :: String -> (BS.ByteString -> Bool) -> IO FileFilter
+contentFilterNew name f = do
+	ff <- fileFilterNew
+	fileFilterSetName ff name
+	fileFilterAddCustom ff [toEnum 1] (\(Just fn) _ _ _ -> do	-- XXX: This is just because of a missing export in Gtk2Hs... shame on them
+		str <- BS.readFile fn
+		return $ f str)
+	return ff
+
+certificateFilterNew :: IO FileFilter
+certificateFilterNew = contentFilterNew "PEM encoded certificates"
+	(\str -> either (const False) (const True) $ importCertificate str X509FmtPem)
+
+privateKeyFilterNew :: IO FileFilter
+privateKeyFilterNew = contentFilterNew "PEM encoded private keys"
+	(\str -> either (const False) (const True) $ importPrivateKey str X509FmtPem)
+
+-- | Creates a 'FileChooserDialog' that previews the username of a selected
+--   certificate.
+certificateLoaderNew :: Maybe FilePath -- ^ An optional initial file selection
+	-> (Maybe String -> IO ())     -- ^ Callback for user selection
+	-> IO CertificateLoader
+certificateLoaderNew certificate callback = mfix $ \result -> do
+	dialog <- fileChooserButtonNew "Select certificate" FileChooserActionOpen
+	props <- hBoxNew False 0
+	lblFor <- labelNew (Just "<b>Username:</b> ")
+	lblFor `set` [labelUseMarkup := True]
+	txtFor <- labelNew Nothing
+	txtFor `set` [labelWidthChars := 20,miscXalign := 0]
+	boxPackStart props lblFor PackNatural 0
+	boxPackStart props txtFor PackGrow 0
+	fileChooserSetUsePreviewLabel dialog False
+	fileChooserSetPreviewWidget dialog props
+	fileChooserSetPreviewWidgetActive dialog True
+	cbref <- newIORef callback
+	dialog `onUpdatePreview` (do
+		callback <- readIORef cbref
+		cert <- certificateLoaderGet result
+		let reset = txtFor `labelSetText` "" >> callback Nothing
+		case cert of
+			Nothing -> reset
+			Just cert -> do
+				case getDnByOid cert oidPKCS9Email 0 of
+					Right (Just email) -> txtFor `labelSetText` (unpack email) >> callback (Just $ unpack email)
+					_ -> reset
+				files <- fileChooserGetFilenames dialog
+				case files of
+					(path:_) -> catch (getLastCertificate >>= (\cert -> writeFile cert path)) (const $ return ())
+					_        -> return ()
+		)
+	ff <- certificateFilterNew
+	fileChooserSetFilter dialog ff
+	widgetShowAll dialog
+	case certificate of
+		Just path -> fileChooserSelectFilename dialog path >> return ()
+		Nothing   -> return ()
+	return (CertLoader dialog cbref)
+
+-- | Tries to read the 'UserID' belonging to a 'Certificate'.
+certificateGetUserID :: Certificate -> Maybe UserID
+certificateGetUserID cert = case getDnByOid cert oidPKCS9Email 0 of
+	Right (Just email) -> let 
+		(name,host) = break (=='@') (unpack email)
+		in if null host then Nothing else Just (UserID name (tail host))
+	_ -> Nothing
+
+-- | Creates a new 'PrivateKeyLoader'.
+privateKeyLoaderNew :: Maybe FilePath -- ^ An optional initial selection
+	-> IO ()                      -- ^ Callback for user selection
+	-> IO PrivateKeyLoader
+privateKeyLoaderNew key callback = do
+	but <- fileChooserButtonNew "Select private key" FileChooserActionOpen
+	ff <- privateKeyFilterNew
+	fileChooserSetFilter but ff
+	cbref <- newIORef callback
+	but `onUpdatePreview` (do
+		f <- readIORef cbref
+		f
+		files <- fileChooserGetFilename but
+		case files of
+			Just path -> catch (getLastKey >>= (\key -> writeFile key path)) (const $ return ())
+			_         -> return ()
+		)
+	case key of
+		Just path -> fileChooserSelectFilename but path >> return ()
+		Nothing   -> return ()
+	return (PrivLoader but cbref)
+
+-- | Returns the currently selected 'Certificate'.
+certificateLoaderGet :: CertificateLoader -> IO (Maybe Certificate)
+certificateLoaderGet (CertLoader ct _) = do
+	fn <- fileChooserGetFilename ct
+	case fn of
+		Nothing  -> return Nothing
+		Just rfn -> loadCertificateFile rfn
+
+loadCertificateFile :: FilePath -> IO (Maybe Certificate)
+loadCertificateFile path = do
+	exists <- doesFileExist path
+	if exists
+		then do
+			str <- BS.readFile path
+			case importCertificate str X509FmtPem of
+				Left _     -> return Nothing
+				Right cert -> return (Just cert)
+		else return Nothing
+
+-- | Returns the currently selected 'PrivateKey'.
+privateKeyLoaderGet :: PrivateKeyLoader -> IO (Maybe PrivateKey)
+privateKeyLoaderGet (PrivLoader ld _) = do
+	fn <- fileChooserGetFilename ld
+	case fn of
+		Nothing -> return Nothing
+		Just rfn -> loadPrivateKeyFile rfn
+
+loadPrivateKeyFile :: FilePath -> IO (Maybe PrivateKey)
+loadPrivateKeyFile path = do
+	exists <- doesFileExist path
+	if exists
+		then do
+			str <- BS.readFile path
+			case importPrivateKey str X509FmtPem of
+				Left _    -> return Nothing
+				Right key -> return (Just key)
+		else return Nothing
+
+-- | Tries to match a 'Certificate' against a 'PrivateKey'.
+certificateKeyMatch :: Certificate -> PrivateKey -> Maybe Bool
+certificateKeyMatch cert key = case (do
+	keyid_cert <- certificateGetKeyId cert
+	keyid_key <- privateKeyGetKeyId key
+	return $ keyid_cert == keyid_key
+	) of
+		Left err -> Nothing
+		Right res -> Just res
+
+loaderStatusNew :: IO LoaderStatus
+loaderStatusNew = do
+	box <- hBoxNew False 0
+	img <- imageNew
+	lbl <- labelNew Nothing
+	lbl `set` [miscXalign:=0]
+	boxPackStart box img PackNatural 0
+	boxPackStart box lbl PackGrow 0
+	return (LoadStat box img lbl)
+
+loaderStatusSetAllMissing :: LoaderStatus -> IO ()
+loaderStatusSetAllMissing (LoadStat _ img lbl) = do
+	imageSetFromStock img stockDialogWarning iconSizeDialog
+	lbl `set` [labelText:="No certificate and private key set."]
+
+loaderStatusSetCertMissing :: LoaderStatus -> IO ()
+loaderStatusSetCertMissing (LoadStat _ img lbl) = do
+	imageSetFromStock img stockDialogWarning iconSizeDialog
+	lbl `set` [labelText:="No certificate set."]
+
+loaderStatusSetPrivMissing :: LoaderStatus -> IO ()
+loaderStatusSetPrivMissing (LoadStat _ img lbl) = do
+	imageSetFromStock img stockDialogWarning iconSizeDialog
+	lbl `set` [labelText:="No private key set."]
+
+loaderStatusSetNotMatch :: LoaderStatus -> IO ()
+loaderStatusSetNotMatch (LoadStat _ img lbl) = do
+	imageSetFromStock img stockDialogError iconSizeDialog
+	lbl `set` [labelText:="Certificate and private key do not match."]
+
+loaderStatusSetOk :: LoaderStatus -> IO ()
+loaderStatusSetOk (LoadStat _ img lbl) = do
+	imageSetFromStock img stockDialogInfo iconSizeDialog
+	lbl `set` [labelText:="Okay."]
+
+loaderStatusUpdate :: LoaderStatus -> CertificateLoader -> PrivateKeyLoader -> IO Bool
+loaderStatusUpdate st cl pl = do
+	mb_cert <- certificateLoaderGet cl
+	mb_priv <- privateKeyLoaderGet pl
+	loaderStatusUpdate' st mb_cert mb_priv
+
+loaderStatusUpdate' :: LoaderStatus -> Maybe Certificate -> Maybe PrivateKey -> IO Bool
+loaderStatusUpdate' st mb_cert mb_priv = do
+	case mb_cert of
+		Nothing -> (case mb_priv of
+			Nothing -> loaderStatusSetAllMissing st 
+			Just _  -> loaderStatusSetCertMissing st) >> return False
+		Just cert -> case mb_priv of
+			Nothing  -> loaderStatusSetPrivMissing st >> return False
+			Just key -> case certificateKeyMatch cert key of
+				Just False -> loaderStatusSetNotMatch st >> return False
+				_ -> loaderStatusSetOk st >> return True
+
+-- | Creates a new 'Loader'. It uses the default paths to read previously stored
+--   selection paths to provide an initial configuration.
+loaderNew :: (Certificate -> PrivateKey -> IO ()) -- ^ Callback for a new user selection
+	-> IO Loader
+loaderNew callback = do
+	cert <- loadLastCertPath
+	key  <- loadLastKeyPath
+	loaderNew' cert key callback
+
+loaderNew' :: Maybe FilePath -> Maybe FilePath -> (Certificate -> PrivateKey -> IO ()) -> IO Loader
+loaderNew' cert key callback = mdo
+	tab <- tableNew 8 2 False
+	catCert <- labelNew (Just "<b>Certificate</b>")
+	catCert `set` [labelUseMarkup := True,miscXalign:=0]
+	descrCert <- labelNew (Just "Certificate file:")
+	descrCert `set` [miscXalign:=0]
+	descrUser <- labelNew (Just "Username:")
+	descrUser `set` [miscXalign:=0]
+	fieldUser <- labelNew Nothing
+	fieldUser `set` [miscXalign:=0]
+	cbref <- newIORef callback
+	let updateBut = loaderStatusUpdate st cl pl >>= widgetSetSensitivity butOk
+	st@(LoadStat box _ _) <- loaderStatusNew
+	pl@(PrivLoader privLoader plcbref) <- privateKeyLoaderNew key updateBut
+	cl@(CertLoader certLoader clcbref) <- certificateLoaderNew cert (\user -> do
+		case user of
+			Nothing -> fieldUser `set` [labelText := "<no username>"]
+			Just email -> fieldUser `set` [labelText := email]
+		updateBut)
+	butOk <- buttonNewFromStock stockOk
+	butOk `widgetSetSensitivity` False
+	butOk `onClicked` (do
+		-- Guaranteed to be Just, because otherwise the button wouldn't be pressable
+		Just cert <- certificateLoaderGet cl
+		Just key  <- privateKeyLoaderGet pl
+		f <- readIORef cbref
+		f cert key
+		)
+	loaderStatusUpdate st cl pl
+	catPrivkey <- labelNew (Just "<b>Private key</b>")
+	catPrivkey `set` [labelUseMarkup:=True,miscXalign:=0]
+	descrPriv <- labelNew (Just "Private key file:")
+	descrPriv `set` [miscXalign:=0]
+	sep <- hSeparatorNew
+	butBox <- vButtonBoxNew
+	butBox `set` [buttonBoxLayoutStyle:=ButtonboxEnd
+		     ,boxHomogeneous:=False]
+	let loader = Loader tab cbref
+	certificate <- case cert of
+		Nothing -> return Nothing
+		Just c  -> loadCertificateFile c
+	privateKey <- case key of
+		Nothing -> return Nothing
+		Just k  -> loadPrivateKeyFile k
+	loaderStatusUpdate' st certificate privateKey >>= widgetSetSensitivity butOk
+	boxPackStart butBox butOk PackNatural 0
+	tableAttach tab catCert 0 2 0 1 [Expand,Fill] [Expand,Fill] 0 0
+	tableAttach tab descrCert 0 1 1 2 [Fill] [Expand,Fill] 10 0
+	tableAttach tab certLoader 1 2 1 2 [Expand,Fill] [Expand,Fill] 0 0
+	tableAttach tab descrUser 0 1 2 3 [Fill] [Expand,Fill] 10 0
+	tableAttach tab fieldUser 1 2 2 3 [Expand,Fill] [Expand,Fill] 0 0
+	tableAttach tab catPrivkey 0 2 3 4 [Expand,Fill] [Expand,Fill] 0 0
+	tableAttach tab descrPriv 0 1 4 5 [Fill] [Expand,Fill] 10 0
+	tableAttach tab privLoader 1 2 4 5 [Expand,Fill] [Expand,Fill] 0 0
+	tableAttach tab sep 0 2 5 6 [Expand,Fill] [] 0 5
+	tableAttach tab box 0 2 6 7 [Expand,Fill] [Expand,Fill] 0 0
+	tableAttach tab butBox 0 2 7 8 [Expand,Fill] [Expand,Fill] 0 0
+	return loader
+
+-- | Returns the 'Widget' to be drawn.
+loaderGetWidget :: Loader -> Widget
+loaderGetWidget (Loader tab _) = toWidget tab
+
+loaderOnEnter :: Loader -> (Certificate -> PrivateKey -> IO ()) -> IO ()
+loaderOnEnter (Loader _ cb) f = writeIORef cb f
+
+loadLastCertPath :: IO (Maybe String)
+loadLastCertPath = catch (do
+		path <- getLastCertificate
+		cert <- readFile path
+		return $ Just cert
+	) (const (return Nothing))
+
+loadLastKeyPath :: IO (Maybe String)
+loadLastKeyPath = catch (do
+		path <- getLastKey
+		key <- readFile path
+		return $ Just key
+	) (const (return Nothing))
+
diff --git a/Barracuda/GUI/ChannelCreator.hs b/Barracuda/GUI/ChannelCreator.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI/ChannelCreator.hs
@@ -0,0 +1,70 @@
+-- |
+-- Maintainer: Henning Guenther
+--
+-- A module containing a widget to create new channels.
+module Barracuda.GUI.ChannelCreator
+	(ChannelCreator()
+	,channelCreatorNew
+	,channelCreatorGetWidget
+	,channelCreatorOnEnter
+	) where
+
+import Data.IORef
+import Graphics.UI.Gtk
+
+-- | A widget to create new channels.
+data ChannelCreator = ChanCreator Table (IORef (String -> String -> Bool -> IO ()))
+
+-- | Initiates a new 'ChannelCreator'.
+channelCreatorNew :: IO ChannelCreator
+channelCreatorNew = do
+	cb <- newIORef (\_ _ _ -> return ())
+	tab <- tableNew 5 2 False
+	lblName <- labelNew (Just "<b>Channelname:</b>")
+	lblName `set` [miscXalign:=0,labelUseMarkup:=True]
+	entrName <- entryNew
+	lblDescr <- labelNew (Just "<b>Description:</b>")
+	lblDescr `set` [miscXalign:=0,labelUseMarkup:=True]
+	entrDescr <- entryNew
+	lblType <- labelNew (Just "<b>Channeltype:</b>")
+	lblType `set` [miscXalign:=0,labelUseMarkup:=True]
+	optPub <- radioButtonNewWithLabel "public"
+	optPriv <- radioButtonNewWithLabelFromWidget optPub "private"
+	butOk <- buttonNewFromStock stockAdd
+	let rcb = do
+		f <- readIORef cb
+		name <- entrName `get` entryText
+		descr <- entrDescr `get` entryText
+		priv <- optPriv `get` toggleButtonActive
+		f name descr priv
+	butOk `onClicked` rcb
+	tab `onKeyPress` (\ev -> case eventKeyName ev of
+		"Return" -> rcb >> return True
+		_ -> return False)
+	entrName `onKeyPress` (\ev -> case eventKeyName ev of
+		"Return" -> rcb >> return True
+		_ -> return False)
+	entrDescr `onKeyPress` (\ev -> case eventKeyName ev of
+		"Return" -> rcb >> return True
+		_ -> return False)
+	butBox <- hButtonBoxNew
+	butBox `set` [buttonBoxLayoutStyle:=ButtonboxEnd]
+	boxPackStart butBox butOk PackNatural 0
+	tableAttach tab lblName 0 1 0 1 [Fill] [Fill] 5 0
+	tableAttach tab lblDescr 0 1 1 2 [Fill] [Fill] 5 0
+	tableAttach tab lblType 0 1 2 4 [Fill] [Fill] 5 0
+	tableAttach tab entrName 1 2 0 1 [Expand,Fill] [Fill] 0 0
+	tableAttach tab entrDescr 1 2 1 2 [Expand,Fill] [Fill] 0 0
+	tableAttach tab optPub 1 2 2 3 [Fill] [Fill] 0 0
+	tableAttach tab optPriv 1 2 3 4 [Fill] [Fill] 0 0
+	tableAttach tab butBox 0 2 4 5 [Fill] [Fill] 0 0
+	return (ChanCreator tab cb)
+
+-- | Sets the callback for a 'ChannelCreator'. It is called with channel name,
+--   channel description and private flag, when the user confirms the data.
+channelCreatorOnEnter :: ChannelCreator -> (String -> String -> Bool -> IO ()) -> IO ()
+channelCreatorOnEnter (ChanCreator _ cb) f = writeIORef cb f
+
+-- | Returns the 'Widget' associated with a 'ChannelCreator'.
+channelCreatorGetWidget :: ChannelCreator -> Widget
+channelCreatorGetWidget (ChanCreator tab _) = toWidget tab
diff --git a/Barracuda/GUI/ChannelList.hs b/Barracuda/GUI/ChannelList.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI/ChannelList.hs
@@ -0,0 +1,183 @@
+-- |
+-- Maintainer: Henning Guenther
+--
+-- A widget listing channels of a network, including their join and privacy status.
+module Barracuda.GUI.ChannelList
+	(ChannelList()
+	,Channel(..)
+	,channelListNew
+	,channelListGetWidget
+	,channelListSetChannels
+	,onChannelSelect
+	,onChannelJoin
+	,onChannelLeave
+	,onChannelCreate
+	) where
+
+import Control.Monad.Fix
+import Data.IORef
+import Data.List
+import Network.AdHoc.Channel
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.ModelView as New
+
+-- | Discribes a ChannelList. In this datatype are the inner TreeView and the outer ScrolledWindow defined. 
+-- Also there is the list of channels and some callbacks for user interaction.
+data ChannelList = ChannelList
+	{outer :: ScrolledWindow
+	,inner :: TreeView
+	,store :: New.ListStore Channel
+	,fonCreate	 :: IORef (IO ())
+	,fonJoin         :: IORef (Channel -> IO ())
+	,fonLeave        :: IORef (Channel -> IO ())
+	,fonSelect	 :: IORef (Channel -> IO ())
+	,connectorSelect :: ConnectId TreeSelection
+	}
+
+-- | This datatype stores the name of a channel and the information if the user has joined and if
+-- it is a private or non private channel.
+data Channel = Chan
+	{name :: String
+	,channelName :: ChannelName
+	,channelID :: ChannelID
+	,private :: Bool
+	,joined :: Bool
+	}
+
+-- | This function deletes all the channels in the given Channellist and replaces them with the given one. 
+channelListSetChannels :: ChannelList -> [Channel] -> Maybe (ChannelName,ChannelID) -> IO ()
+channelListSetChannels wid chans sel = do
+	signalBlock (connectorSelect wid)
+	let ind = (do
+		(cname,cid) <- sel
+		findIndex (\ch -> channelName ch == cname && channelID ch == cid) chans)
+	New.listStoreClear (store wid)
+	mapM_ (New.listStoreAppend (store wid)) chans
+	case ind of
+		Nothing -> return ()
+		Just rind -> do
+			selection <- New.treeViewGetSelection (inner wid)
+			New.treeSelectionSelectPath selection [rind]
+	signalUnblock (connectorSelect wid)
+
+-- | Returns the ChannelList as a Widget
+channelListGetWidget :: ChannelList -> Widget
+channelListGetWidget = toWidget.outer
+
+-- | Creates a new ChannelList with a list of Channels, the inner TreeView and the outer ScrolledWindow. 
+-- Also there are some callbacks for the user interaction. 
+channelListNew :: IO ChannelList
+channelListNew = mfix $ \cl -> do
+	ls <- New.listStoreNew ([]::[Channel])
+	sw <- scrolledWindowNew Nothing Nothing
+	sw `set` [scrolledWindowHscrollbarPolicy:=PolicyAutomatic
+		 ,scrolledWindowVscrollbarPolicy:=PolicyAutomatic
+		 ,scrolledWindowShadowType:=ShadowEtchedIn]
+	tv <- New.treeViewNewWithModel ls
+	col0 <- New.treeViewColumnNew
+	col1 <- New.treeViewColumnNew
+	col2 <- New.treeViewColumnNew
+	New.treeViewSetHeadersVisible tv True
+	New.treeViewColumnSetTitle col1 "Name"
+	
+	renderer0 <- New.cellRendererPixbufNew
+	renderer1 <- New.cellRendererTextNew
+	renderer2 <- New.cellRendererPixbufNew
+	New.cellLayoutPackStart col0 renderer0 False
+	New.cellLayoutPackStart col1 renderer1 True
+	New.cellLayoutPackStart col2 renderer2 False
+	New.cellLayoutSetAttributes col0 renderer0 ls
+		$ \row -> [New.cellPixbufStockId:=if private row
+			then "gtk-dialog-authentication"
+			else ""]
+	New.cellLayoutSetAttributes col1 renderer1 ls
+		$ \row -> [New.cellText:=name row]
+	New.cellLayoutSetAttributes col2 renderer2 ls
+		$ \row -> [New.cellPixbufStockId:=if joined row
+			then "gtk-connect"
+			else "gtk-disconnect"
+			]
+	New.treeViewAppendColumn tv col2
+	New.treeViewAppendColumn tv col0
+	New.treeViewAppendColumn tv col1
+	treeSel <- New.treeViewGetSelection tv
+	tv `onButtonPress` (\ev -> do
+		case eventButton ev of
+			RightButton -> do
+				men <- channelListCtxMenu cl (round $ eventX ev,round $ eventY ev)
+				menuPopup men (Just (RightButton,eventTime ev))
+				return False
+			_ -> return False
+		)
+	cid <- treeSel `New.onSelectionChanged` (do
+		f <- readIORef (fonSelect cl)
+		sel <- New.treeSelectionGetSelectedRows treeSel
+		case sel of
+			[[row]] -> New.listStoreGetValue ls row >>= f
+			_ -> return ()
+		)
+	tv `New.onRowActivated` (\[row] _ -> do
+		f <- readIORef (fonJoin cl)
+		New.listStoreGetValue ls row >>= f
+		)
+	sw `containerAdd` tv
+	zeroFunc1 <- newIORef (return ())
+	zeroFunc2 <- newIORef (const $ return ())
+	zeroFunc3 <- newIORef (const $ return ())
+	zeroFunc4 <- newIORef (const $ return ())
+	return $ ChannelList sw tv ls zeroFunc1 zeroFunc2 zeroFunc3 zeroFunc4 cid
+
+-- | Gives a callback if a user selects a channel in the list.
+onChannelSelect :: ChannelList -> (Channel -> IO ()) -> IO ()
+onChannelSelect wid f = writeIORef (fonSelect wid) f
+
+-- | Gives a callback if a user clicks on Join in the context menu.
+onChannelJoin :: ChannelList -> (Channel -> IO ()) -> IO ()
+onChannelJoin wid f = writeIORef (fonJoin wid) f
+
+-- | Gives a callback if a user clicks on Leave in the context menu.
+onChannelLeave :: ChannelList -> (Channel -> IO ()) -> IO ()
+onChannelLeave wid f = writeIORef (fonLeave wid) f
+
+-- | Gives a callback if a user clicks on the <add Channel> button in the context menu.
+onChannelCreate :: ChannelList -> IO () -> IO ()
+onChannelCreate wid f = writeIORef (fonCreate wid) f
+-- | This function is used to create the connect/disconnect and private/not private images.
+channelListCtxMenu :: ChannelList -> Point -> IO Menu
+channelListCtxMenu cl point = do
+	sel <- New.treeViewGetPathAtPos (inner cl) point
+	ch <- case sel of
+		Nothing -> return Nothing
+		Just ([row],_,_) -> New.listStoreGetValue (store cl) row >>= return.Just
+	men <- menuNew
+	case ch of
+		Just chan -> if not (joined chan)
+			then (do
+				joinImg <- imageNewFromStock "gtk-connect" 1
+				itJoin <- imageMenuItemNewWithLabel "Join"
+				imageMenuItemSetImage itJoin joinImg
+				itJoin `onActivateLeaf` (do
+					f <- readIORef (fonJoin cl)
+					f chan
+					)
+				menuShellAppend men itJoin
+				)
+			else (do
+				leaveImg <- imageNewFromStock "gtk-disconnect" 1
+				itLeave <- imageMenuItemNewWithLabel "Leave"
+				imageMenuItemSetImage itLeave leaveImg
+				itLeave `onActivateLeaf` (do
+					f <- readIORef (fonLeave cl)
+					f chan)
+				menuShellAppend men itLeave
+			)
+		_ -> return ()
+	createImg <- imageNewFromStock "gtk-add" 1
+	itCreate <- imageMenuItemNewWithLabel "Create"
+	imageMenuItemSetImage itCreate createImg
+	itCreate `onActivateLeaf` (do
+		f <- readIORef (fonCreate cl)
+		f)
+	menuShellAppend men itCreate
+	widgetShowAll men
+	return men
diff --git a/Barracuda/GUI/ChannelManager.hs b/Barracuda/GUI/ChannelManager.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI/ChannelManager.hs
@@ -0,0 +1,179 @@
+-- |
+-- Maintainer: Henning Guenther
+--
+-- The ChannelManager represents the state of the currently displayed channel.
+module Barracuda.GUI.ChannelManager
+	(ChannelManager(view)
+	,channelManagerNew
+	,channelManagerChannel
+	,channelManagerError
+	,channelManagerUsername
+	,channelManagerSelect
+	,channelManagerCheckState
+	,channelManagerRenderState
+	,channelManagerUpdate
+	,channelManagerUsers
+	,channelManagerPost
+	,channelManagerWantsAuth
+	,channelManagerNoState
+	) where
+
+import Control.Monad (unless)
+import Data.IORef
+import Data.Map as Map
+import Data.Set as Set
+import Data.Time.Clock
+
+import Network.AdHoc.Channel
+import Network.AdHoc.Message
+import Network.AdHoc.UserID
+
+import Graphics.UI.Gtk
+import Barracuda.GUI.ChatView
+
+data ChannelManagerState
+	= DontKnow
+	| ListenTo 
+	| LookFromOutside
+	| ChannelVanished 
+	deriving Eq
+
+data ChannelManager = ChannelManager
+	{channels :: Channels
+	,username :: UserID
+	,state :: Maybe ((ChannelName,ChannelID),ChannelManagerState)
+	,view :: ChatView
+	,downloadCB :: [Attachment] -> IO ()
+	,authCB :: ChannelName -> ChannelID -> UserID -> IO ()
+	}
+
+type Channels = Map (ChannelName,ChannelID) (String,Bool,Set UserID,Maybe ChatContent)
+
+-- | Creates a new ChannelManager instance
+channelManagerNew :: ([Attachment] -> IO ())
+		  -> (ChannelName -> ChannelID -> UserID -> IO ())
+		  -> UserID
+		  -> IO ChannelManager
+channelManagerNew cb cb2 name = do
+	cv <- chatViewNew
+	return $ ChannelManager
+		{channels = Map.empty
+		,username = name
+		,state = Nothing
+		,view = cv
+		,downloadCB = cb
+		,authCB = cb2
+		}
+
+-- | Checks if the displaying widget needs to be changed and does so with the
+--   provided callback.
+channelManagerCheckState :: ChannelManager -> (Widget -> IO ()) -> IO ChannelManager
+channelManagerCheckState cm adder = let
+	nst = case state cm of
+		Nothing -> Nothing
+		Just (chan,_) -> Just $ case Map.lookup chan (channels cm) of
+			Nothing -> (chan,ChannelVanished)
+			Just (_,_,users,_) -> if Set.member (username cm) users
+				then (chan,ListenTo)
+				else (chan,LookFromOutside)
+	in if state cm == nst
+		then return cm
+		else (do
+			(ncm,wid) <- channelManagerRenderState (cm {state = nst})
+			adder wid
+			return ncm)
+
+-- | Creates a widget to diplay the current state of the manager
+channelManagerRenderState :: ChannelManager -> IO (ChannelManager,Widget)
+channelManagerRenderState cm = let
+	out = do
+		lbl <- labelNew (Just $ "You're not a member of this channel.")
+		return (cm,toWidget lbl)
+	in case state cm of
+		Nothing -> do
+			lbl <- labelNew (Just "Barracuda - Error")
+			return (cm,toWidget lbl)
+		Just ((cname,cid),st) -> case st of
+			ListenTo -> do
+				ncm <- withChatContent cname cid (chatViewSetChatContent (view cm)) cm
+				return (ncm,chatViewGetWidget (view cm))
+			LookFromOutside -> out
+			ChannelVanished -> do
+				lbl <- labelNew (Just $ (show cname) ++ " has been closed or does not exist for another reason.")
+				return (cm,toWidget lbl)
+
+{- | Update the channel informations of the manager using the contents of an
+ -   'AllChans' message.
+ -}
+channelManagerUpdate :: Map (ChannelName,ChannelID) (String,Bool,Set UserID)
+		     -> ChannelManager
+		     -> ChannelManager
+channelManagerUpdate mp cm = let
+		nmp = Map.map (\(name,priv,usrs) -> (name,priv,usrs,Nothing)) mp
+		in cm {channels = Map.differenceWith (\(name,priv,usrs,_) (_,_,_,oconts)
+			-> Just (name,priv,usrs,case oconts of
+				Nothing -> Nothing
+				Just roconts -> if Set.member (username cm) usrs
+					then Just roconts
+					else Nothing)) nmp (channels cm)
+			}
+
+-- | Gets the users that needs to be displayed by the 'ChannelList'
+channelManagerUsers :: ChannelManager -> [UserID]
+channelManagerUsers cm = case state cm of
+	Nothing -> []
+	Just (chan,_) -> case Map.lookup chan (channels cm) of
+		Nothing -> []
+		Just (_,_,usrs,_) -> Set.toList usrs
+
+withChatContent :: ChannelName -> ChannelID -> (ChatContent -> IO ()) -> ChannelManager -> IO ChannelManager
+withChatContent cname cid f cm = do
+	let newcc = do
+		ncc <- chatContentNew (chatViewGetWidget $ view cm)
+		ncc `onDownload` (downloadCB cm)
+		ncc `onAuth` (authCB cm cname cid)
+		return ncc
+	(cc,ncm) <- case Map.lookup (cname,cid) (channels cm) of
+		Just (_,_,_,Just x) -> return (x,cm)
+		Just (title,priv,users,Nothing) -> do
+			ncc <- newcc
+			return (ncc,cm {channels=Map.insert (cname,cid) (title,priv,users,Just ncc) (channels cm)})
+		Nothing -> do
+			ncc <- newcc
+			let n = ("",False,Set.empty,Just ncc)
+			return (ncc,cm {channels=Map.insert (cname,cid) n (channels cm)})
+	f cc
+	return ncm
+
+-- | Display the message of a user in a specific channel.
+channelManagerPost :: ChannelName -> ChannelID -> UTCTime -> Maybe UserID -> String -> [Attachment] -> Bool -> ChannelManager -> IO ChannelManager
+channelManagerPost cname cid time from text attach delayed cm = do
+	ncm <- withChatContent cname cid (chatContentInsert time from text attach delayed) cm
+	chatViewScroll (view ncm)
+	return ncm
+
+-- | Posts an error into a channel.
+channelManagerError :: ChannelName -> ChannelID -> UTCTime -> String -> ChannelManager -> IO ChannelManager
+channelManagerError cname cid time text cm = do
+	ncm <- withChatContent cname cid (chatContentError time text) cm
+	chatViewScroll (view ncm)
+	return ncm
+
+-- | Posts an authorization request from another user into a channel.
+channelManagerWantsAuth :: ChannelName -> ChannelID -> UTCTime -> UserID -> ChannelManager -> IO ChannelManager
+channelManagerWantsAuth cname cid time from cm = do
+	ncm <- withChatContent cname cid (chatContentWantAuth time from) cm
+	chatViewScroll (view ncm)
+	return ncm
+
+channelManagerChannel :: ChannelManager -> Maybe (ChannelName,ChannelID,Bool)
+channelManagerChannel cm = state cm >>= \((cname,cid),st) -> return (cname,cid,st == ListenTo)
+
+channelManagerSelect :: ChannelName -> ChannelID -> ChannelManager -> ChannelManager
+channelManagerSelect cname cid cm = cm {state = Just ((cname,cid),DontKnow)}
+
+channelManagerNoState :: ChannelManager -> ChannelManager
+channelManagerNoState cm = cm {state = Nothing}
+
+channelManagerUsername :: ChannelManager -> UserID
+channelManagerUsername = username
diff --git a/Barracuda/GUI/ChatView.hs b/Barracuda/GUI/ChatView.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI/ChatView.hs
@@ -0,0 +1,191 @@
+-- |
+-- Maintainer: Henning Guenther, Oliver Mielentz
+--
+-- The central gui widget displaying the messages of the channels.
+module Barracuda.GUI.ChatView
+	(ChatView
+	,ChatContent
+	,chatViewNew
+	,chatContentNew
+	,chatViewSetChatContent
+	,chatViewGetWidget
+	,chatViewScroll
+	,chatContentInsert
+	,chatContentWantAuth
+	,chatContentError
+	,onDownload
+	,onAuth
+	) where
+
+import Data.Map as Map
+import Graphics.UI.Gtk
+
+import Control.Monad (when)
+import Data.IORef
+import Data.Time
+import System.Locale
+import Network.AdHoc.UserID
+import Network.AdHoc.Message
+
+-- | A 'ChatView' is a Widget that displays the content of a 'ChatContent'
+data ChatView = ChatView ScrolledWindow TextView
+
+-- | A 'ChatContent' represents a buffer with messages, e.g. for a specific
+--   channel
+data ChatContent = ChatContent
+	{buffer           :: TextBuffer
+	,tagtable         :: TextTagTable
+	,tagBold          :: TextTag
+	,tagWarn          :: TextTag
+	,tagDelayed       :: TextTag
+	,callbackDownload :: IORef ([Attachment] -> IO ())
+	,callbackAuth     :: IORef (UserID -> IO ())
+	,imgSave          :: Pixbuf
+	,imgApply         :: Pixbuf
+	}
+
+-- | Retrieves the main Widget of a 'ChatView'. Can be used to insert the
+--   'ChatView' into another Widget.
+chatViewGetWidget :: ChatView -> Widget
+chatViewGetWidget (ChatView wid _) = toWidget wid
+
+-- | Sets the content of a 'ChatView'.
+chatViewSetChatContent :: ChatView -> ChatContent -> IO ()
+chatViewSetChatContent (ChatView _ cv) cc = textViewSetBuffer cv (buffer cc)
+
+-- | Creates a 'ChatView' Widget without any content.
+chatViewNew :: IO ChatView
+chatViewNew = do
+	win <- scrolledWindowNew Nothing Nothing
+	win `set` [scrolledWindowVscrollbarPolicy := PolicyAlways
+		  ,scrolledWindowHscrollbarPolicy := PolicyNever]
+	cv <- textViewNew
+	cv `set` [textViewEditable := False
+		 ,textViewWrapMode := WrapWordChar
+		 ,textViewCursorVisible := False
+		 ]
+	containerAdd win cv
+	return (ChatView win cv)
+
+chatContentTimestamp :: UTCTime -> ChatContent -> IO ()
+chatContentTimestamp time cc = do
+	timezone <- getCurrentTimeZone
+	let time_str = formatTime defaultTimeLocale "%R" (utcToLocalTime timezone time)
+	iter <- textBufferGetEndIter (buffer cc)
+	textBufferInsert (buffer cc) iter time_str
+	time_iter <- textIterCopy iter
+	textIterBackwardChars time_iter (length time_str)
+	textBufferApplyTag (buffer cc) (tagBold cc) iter time_iter
+
+-- | Inserts a message with timestamp, text and attachments into a
+--   'ChatContent'.
+chatContentInsert :: UTCTime -> Maybe UserID -> String -> [Attachment] -> Bool -> ChatContent -> IO ()
+chatContentInsert time sender txt attachments delayed cv = do
+	chatContentTimestamp time cv
+	iter <- textBufferGetEndIter (buffer cv)
+	let prefix = case sender of
+		Nothing -> " <anonymous>"
+		Just rsender -> " <"++show rsender++">"
+	textBufferInsert (buffer cv) iter prefix
+	when delayed (do
+		textBufferInsert (buffer cv) iter " [delayed]"
+		delIter <- textIterCopy iter
+		textIterBackwardChars delIter 10
+		textBufferApplyTag (buffer cv) (tagDelayed cv) delIter iter)
+	textBufferInsert (buffer cv) iter (" "++txt)
+	case attachments of
+		[] -> return ()
+		_  -> do
+			textBufferInsert (buffer cv) iter " "
+			textBufferInsertPixbuf (buffer cv) iter (imgSave cv)
+			picIter <- textIterCopy iter
+			textIterBackwardChar picIter
+			save_tag <- textTagNew Nothing
+			save_tag `onTextTagEvent` (\ev _ -> case ev of
+				Button _ SingleClick _ _ _ [] LeftButton _ _ -> do
+					cb <- readIORef (callbackDownload cv)
+					cb attachments
+				_ -> return ()
+				)
+			textTagTableAdd (tagtable cv) save_tag
+			textBufferApplyTag (buffer cv) save_tag iter picIter
+			return ()
+	textBufferInsert (buffer cv) iter "\n"
+
+chatContentWantAuth :: UTCTime -> UserID -> ChatContent -> IO ()
+chatContentWantAuth time from cc = do
+	chatContentTimestamp time cc
+	iter <- textBufferGetEndIter (buffer cc)
+	textBufferInsert (buffer cc) iter (" "++show from++" wants to join. Allow? ")
+	textBufferInsertPixbuf (buffer cc) iter (imgApply cc)
+	picIter <- textIterCopy iter
+	textIterBackwardChar picIter
+	apply_tag <- textTagNew Nothing
+	apply_tag `onTextTagEvent` (\ev _ -> case ev of
+		Button _ SingleClick _ _ _ [] LeftButton _ _ -> do
+			cb <- readIORef (callbackAuth cc)
+			cb from
+		_ -> return ())
+	textTagTableAdd (tagtable cc) apply_tag
+	textBufferApplyTag (buffer cc) apply_tag iter picIter
+	textBufferInsert (buffer cc) iter ("\n")
+
+-- | Creates an empty 'ChatContent'(no messages in it).
+chatContentNew :: WidgetClass w => w -> IO ChatContent
+chatContentNew wid = do
+	Just pbApply <- widgetRenderIcon wid stockApply iconSizeMenu ""
+	Just pbSave <- widgetRenderIcon wid stockSave iconSizeMenu ""
+	tt <- textTagTableNew
+	buf <- textBufferNew (Just tt)
+	func <- newIORef (const $ return ())
+	func2 <- newIORef (const $ return ())
+	tb <- textTagNew Nothing
+	tb `set` [textTagWeight := fromEnum WeightBold]
+	tw <- textTagNew Nothing
+	tw `set` [textTagForeground := "red"]
+	td <- textTagNew Nothing
+	td `set` [textTagForeground := "orange"]
+	textTagTableAdd tt tb
+	textTagTableAdd tt tw
+	textTagTableAdd tt td
+	return $ ChatContent
+		{buffer = buf
+		,tagtable = tt
+		,tagBold = tb
+		,tagWarn = tw
+		,tagDelayed = td
+		,callbackDownload = func
+		,callbackAuth = func2
+		,imgApply = pbApply
+		,imgSave = pbSave
+		}
+
+chatContentError :: UTCTime -> String -> ChatContent -> IO ()
+chatContentError time txt cc = do
+	chatContentTimestamp time cc
+	iter <- textBufferGetEndIter (buffer cc)
+	textBufferInsert (buffer cc) iter (" "++txt)
+	iter2 <- textIterCopy iter
+	textIterBackwardChars iter2 (length txt)
+	textBufferApplyTag (buffer cc) (tagWarn cc) iter iter2
+	textBufferInsert (buffer cc) iter "\n"
+
+-- | Sets a callback function to be called whenever the user wants to save
+--   specific attachments.
+onDownload :: ChatContent -> ([Attachment] -> IO ()) -> IO ()
+onDownload cc f = modifyIORef (callbackDownload cc) (const f)
+
+-- | Sets a callback function to be called whenever the user wants to
+--   allow another user into the channel.
+onAuth :: ChatContent -> (UserID -> IO ()) -> IO ()
+onAuth cc f = modifyIORef (callbackAuth cc) (const f)
+
+chatViewScroll :: ChatView -> IO ()
+chatViewScroll (ChatView win cv) = do
+	buf <- textViewGetBuffer cv
+	iter <- textBufferGetEndIter buf
+	textViewScrollToIter cv iter 0 Nothing
+--	adj <- win `get` scrolledWindowVAdjustment
+--	max <- adjustmentGetUpper adj
+--	adjustmentSetValue adj max
+	return ()
diff --git a/Barracuda/GUI/DownloadManager.hs b/Barracuda/GUI/DownloadManager.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI/DownloadManager.hs
@@ -0,0 +1,83 @@
+{- | The download manager displays attachments to the user and lets them save
+     them.
+ -}
+module Barracuda.GUI.DownloadManager
+	(DownloadManager()
+	,downloadManagerNew
+	,downloadManagerGetWidget
+	) where
+
+import Network.AdHoc.Message
+
+import Data.ByteString as BS
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.ModelView as New
+import System.FilePath
+import Prelude hiding (catch)
+import Control.Exception(catch)
+
+-- | A widget to save attachments of messages.
+data DownloadManager = DLManager
+	{store :: New.ListStore Attachment
+	,outer :: VBox
+	}
+
+-- | Creates a new 'DownloadManager' with a list of attachments to download.
+downloadManagerNew :: [Attachment] -> IO DownloadManager
+downloadManagerNew attach = do
+	ls <- New.listStoreNew attach
+	box <- vBoxNew False 0
+	sw <- scrolledWindowNew Nothing Nothing
+	sw `set` [scrolledWindowHscrollbarPolicy:=PolicyAutomatic
+		 ,scrolledWindowVscrollbarPolicy:=PolicyAutomatic
+		 ,scrolledWindowShadowType:=ShadowEtchedIn]
+	tv <- New.treeViewNewWithModel ls
+	selection <- New.treeViewGetSelection tv
+	selection `set` [New.treeSelectionMode:=SelectionMultiple]
+	New.treeSelectionSelectAll selection
+	colName <- New.treeViewColumnNew
+	New.treeViewSetHeadersVisible tv False
+	rendererName <- New.cellRendererTextNew
+	New.cellLayoutPackStart colName rendererName True
+	New.cellLayoutSetAttributes colName rendererName ls
+		$ \row -> [New.cellText:=attachmentFilename row]
+	New.treeViewAppendColumn tv colName
+	sw `containerAdd` tv
+	boxPackStart box sw PackGrow 0
+	but_save <- buttonNewFromStock stockSave
+	boxPackStart box but_save PackNatural 0
+	but_save `onClicked` (do
+		dialog <- fileChooserDialogNew Nothing Nothing
+			FileChooserActionSelectFolder
+			[(stockSave,ResponseOk)]
+		resp <- dialogRun dialog
+		case resp of
+			ResponseOk -> do
+				Just path <- fileChooserGetCurrentFolder dialog
+				rows <- New.treeSelectionGetSelectedRows selection
+				mapM_ (\[num] -> do
+					attachment <- New.listStoreGetValue ls num
+					
+					(BS.writeFile
+						(path </> (attachmentFilename attachment))
+						(attachmentContent attachment))
+						`catch`
+						(\ex -> do
+							dia <- messageDialogNew Nothing []
+								MessageError ButtonsOk ("Failed to save attachment: "++show ex)
+							windowSetTitle dia "Error"
+							print "ERROR"
+							dialogRun dia
+							widgetDestroy dia)
+					) rows
+				widgetDestroy dialog
+			_ -> widgetDestroy dialog
+		)
+	return $ DLManager 
+		{store=ls
+		,outer=box
+		}
+
+-- | Gets the 'Widget' of a 'DownloadManager'.
+downloadManagerGetWidget :: DownloadManager -> Widget
+downloadManagerGetWidget dl = toWidget (outer dl)
diff --git a/Barracuda/GUI/Infrastructure.hs b/Barracuda/GUI/Infrastructure.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI/Infrastructure.hs
@@ -0,0 +1,131 @@
+{- | A widget to manipulate the infrastructure mode of the node.
+ -}
+module Barracuda.GUI.Infrastructure
+	(InfrastructureWidget()
+	,infrastructureWidgetNew
+	,infrastructureWidgetGet
+	,onUpdate)
+	where
+
+import Barracuda.GUI.Utils
+import Barracuda.Utils
+import Network.Socket
+
+import Data.IORef
+
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.ModelView as New
+
+data Infrastructure = Infrastructure
+	{list :: New.ListStore SockAddr
+	,view :: New.TreeView
+	}
+
+-- | A widget to edit the infrastructural data.
+data InfrastructureWidget = InfrastructureWidget
+	{ips :: Infrastructure
+	,outer :: VBox
+	,fonUpdate :: IORef (Maybe [SockAddr] -> IO ())
+	}
+
+-- | Creates a new 'InfrastructureWidget'.
+infrastructureWidgetNew :: IO InfrastructureWidget
+infrastructureWidgetNew = do
+	inf <- infrastructureNew
+	box <- vBoxNew False 0
+	butActive <- checkButtonNewWithLabel "infrastructure mode active"
+	boxPackStart box butActive PackNatural 0
+	sw <- scrolledWindowNew Nothing Nothing
+	sw `set` [scrolledWindowHscrollbarPolicy := PolicyNever
+		 ,scrolledWindowVscrollbarPolicy := PolicyAutomatic
+		 ,scrolledWindowShadowType := ShadowEtchedIn]
+	sw `containerAdd` (view inf)
+	boxPackStart box sw PackGrow 0
+	entrBox <- hBoxNew False 0
+	entrIp <- entryNew
+	entrIp `set` [entryWidthChars := 15]
+	boxPackStart entrBox entrIp PackGrow 0
+	lblDot <- labelNew (Just ":")
+	boxPackStart entrBox lblDot PackNatural 0
+	entrPort <- entryNew
+	entrPort `set` [entryWidthChars := 6]
+	boxPackStart entrBox entrPort PackGrow 0
+	addBut <- buttonNewFromStock stockAdd
+	addBut `onClicked` (do
+		ip <- entrIp `get` entryText
+		port <- entrPort `get` entryText
+		case (readSockAddr 8888 (ip++":"++port)) of
+			Nothing -> return ()
+			Just addr -> do
+				infrastructureAdd inf addr
+				entrPort `set` [entryText:=""]
+				entrIp   `set` [entryText:=""]
+		)
+	boxPackStart entrBox addBut PackGrow 0
+	boxPackStart box entrBox PackNatural 0
+	f <- newIORef (const (return ()))
+	saveBut <- buttonNewFromStock stockSave
+	saveBut `onClicked` (do
+		act <- butActive `get` toggleButtonActive
+		cb <- readIORef f
+		if act then (do
+			lst <- listStoreGetValues (list inf)
+			cb (Just lst)) else (cb Nothing)
+		)
+	boxPackStart box saveBut PackNatural 0
+	let togg yes = do
+		widgetSetSensitivity (view inf) yes
+		widgetSetSensitivity addBut yes
+		widgetSetSensitivity entrIp yes
+		widgetSetSensitivity entrPort yes
+	butActive `onToggled` (do
+		act <- butActive `get` toggleButtonActive
+		togg act)
+	togg False
+	return $ InfrastructureWidget inf box f
+
+infrastructureNew :: IO Infrastructure
+infrastructureNew = do
+	ls <- New.listStoreNew []
+	tv <- New.treeViewNewWithModel ls
+	colIP   <- New.treeViewColumnNew
+	colPort <- New.treeViewColumnNew
+	New.treeViewColumnSetTitle colIP "IP"
+	New.treeViewColumnSetTitle colPort "Port"
+	rendererIP   <- New.cellRendererTextNew
+	rendererIP `set` [New.cellWidthChars:=15]
+	rendererPort <- New.cellRendererTextNew
+	rendererPort `set` [New.cellWidthChars:=6]
+	New.cellLayoutPackStart colIP   rendererIP   True
+	New.cellLayoutPackStart colPort rendererPort True
+	New.cellLayoutSetAttributes colIP rendererIP ls
+		$ \(SockAddrInet _ host) -> [New.cellText:=showHost host]
+	New.cellLayoutSetAttributes colPort rendererPort ls
+		$ \(SockAddrInet port _) -> [New.cellText:=show port]
+	New.treeViewAppendColumn tv colIP
+	New.treeViewAppendColumn tv colPort
+	tv `onKeyPress` (\ev -> if eventKeyName ev == "Delete"
+		then (do
+			sel <- New.treeViewGetSelection tv
+			rows <- New.treeSelectionGetSelectedRows sel
+			mapM_ (\[row] -> New.listStoreRemove ls row) rows
+			return True
+			)
+		else return False)
+	return $ Infrastructure
+		{list = ls
+		,view = tv
+		}
+
+infrastructureAdd :: Infrastructure -> SockAddr -> IO ()
+infrastructureAdd inf addr = New.listStoreAppend (list inf) addr
+
+{- | Sets the function to be called whenever the user sets new infrastructure
+     informations.
+ -}
+onUpdate :: InfrastructureWidget -> (Maybe [SockAddr] -> IO ()) -> IO ()
+onUpdate inf f = writeIORef (fonUpdate inf) f
+
+-- | Returns the associated 'Widget'.
+infrastructureWidgetGet :: InfrastructureWidget -> Widget
+infrastructureWidgetGet = toWidget.outer
diff --git a/Barracuda/GUI/InputField.hs b/Barracuda/GUI/InputField.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI/InputField.hs
@@ -0,0 +1,142 @@
+-- |
+-- Maintainer: Henning Guenther
+--
+-- The widget used to enter messages and attachments.
+module Barracuda.GUI.InputField
+	(InputField()
+	,inputFieldNew
+	,inputFieldGetWidget
+	,inputFieldClear
+	,onSend
+	) where
+
+import qualified Data.ByteString as BS
+import Graphics.UI.Gtk.ModelView as New
+import Graphics.UI.Gtk
+import Data.IORef
+import System.FilePath (splitFileName)
+import Barracuda.GUI.Utils
+import Network.AdHoc.Message (Attachment(..))
+
+-- | A widget to enter messages with optional attachments.
+data InputField = InputField
+	{widget :: VBox
+	,attachments :: New.ListStore File
+	,sendButton :: Button
+	,entry :: Entry
+	,callback :: IORef (String -> [Attachment] -> IO ())
+	}
+
+-- | Defines a File as a tupel of the filename as a String and the location of a file as a FilePath.
+data File = File
+	{fileName :: String
+	,fileLocation :: FilePath
+	}
+	deriving Show
+
+fileToAttachment :: File -> IO Attachment
+fileToAttachment file = do
+	str <- BS.readFile (fileLocation file)
+	return (Attachment (fileName file) "application/octet-stream" str)
+
+-- | Creates a new InputField and returns it as a vBox
+inputFieldNew :: IO InputField
+inputFieldNew = do
+	vbox <- vBoxNew False 0
+	inpBox <- hBoxNew False 0
+	inpText <- entryNew
+	inpSend <- buttonNewWithLabel "Send"
+	butImg <- imageNew
+	imageSetFromStock butImg "gtk-execute" 1
+	buttonSetImage inpSend butImg
+	exp <- expanderNew "Attachments"
+	ls <- New.listStoreNew []
+	icons <- New.iconViewNewWithModel ls
+	rendererDescr <- New.cellRendererTextNew
+	rendererIcon <- New.cellRendererPixbufNew
+	New.cellLayoutPackStart icons rendererIcon False
+	New.cellLayoutPackStart icons rendererDescr False
+	New.cellLayoutSetAttributes icons rendererDescr ls $ \row ->
+		[New.cellText:=fileName row
+		,New.cellWidthChars:=(-1)
+		,New.cellXAlign:=0.5
+		,New.cellEditable:=True
+		]
+	rendererDescr `New.onEdited` (\[tp] str -> do
+		file <- New.listStoreGetValue ls tp
+		New.listStoreSetValue ls tp (file {fileName=str})
+		)
+	New.cellLayoutSetAttributes icons rendererIcon ls
+		$ \row -> [New.cellPixbufStockId:="gtk-file",New.cellPixbufStockSize:=2]
+	New.iconViewSetSelectionMode icons SelectionMultiple
+	New.iconViewSetRowSpacing icons 0
+	icons `onKeyPress` (\ev -> do
+		if eventKeyName ev == "Delete"
+			then (do
+				items <- New.iconViewGetSelectedItems icons
+				mapM_ ((New.listStoreRemove ls).head) items
+				return True
+				)
+			else return False
+		)
+	sw <- scrolledWindowNew Nothing Nothing
+	sw `set` [scrolledWindowHscrollbarPolicy:=PolicyNever
+		 ,scrolledWindowVscrollbarPolicy:=PolicyAutomatic
+		 ,scrolledWindowShadowType:=ShadowEtchedIn]
+	sw `containerAdd` icons
+	exp `containerAdd` sw
+	boxPackStart inpBox inpText PackGrow 0
+	boxPackStart inpBox inpSend PackNatural 0
+	boxPackStart vbox inpBox PackNatural 0
+	boxPackStart vbox exp PackGrow 0
+	cb <- newIORef (const $ const $ return ())
+	let runCB = do
+		text <- entryGetText inpText
+		att <- listStoreGetValues ls >>= mapM fileToAttachment
+		f <- readIORef cb
+		f text att
+	inpSend `onClicked` runCB
+	inpText `onEntryActivate` runCB
+	icons `onButtonPress` (\ev -> case ev of
+		Button _ SingleClick time x y [] RightButton _ _ -> do
+			men <- menuNew
+			addImg <- imageNewFromStock "gtk-add" 1
+			itAdd <- imageMenuItemNewWithLabel "Add file"
+			imageMenuItemSetImage itAdd addImg
+			menuShellAppend men itAdd
+			itAdd `onActivateLeaf` (do
+				dialog <- fileChooserDialogNew Nothing Nothing FileChooserActionOpen [("gtk-cancel",ResponseCancel),("gtk-open",ResponseOk)]
+				resp <- dialogRun dialog
+				case resp of
+					ResponseCancel -> return ()
+					ResponseOk -> do
+						fn <- fileChooserGetFilename dialog
+						case fn of
+							Nothing -> return ()
+							Just rfn -> do
+								let (dir,name) = splitFileName rfn
+								New.listStoreAppend ls (File name rfn) 
+				widgetDestroy dialog
+				return ()
+				)
+			widgetShowAll men
+			menuPopup men (Just (RightButton,time))
+			return True
+		_ -> return False
+		)
+	return (InputField vbox ls inpSend inpText cb)
+
+-- | Returns the 'Widget' associated to an 'InputField'.
+inputFieldGetWidget :: InputField -> Widget
+inputFieldGetWidget ifi = toWidget (widget ifi)
+
+-- | Sets a callback to be invoked whenever the user sends a message. Its
+--   parameters are the actual text and a list of 'Attachment's.
+onSend :: InputField -> (String -> [Attachment] -> IO ()) -> IO ()
+onSend ifi f = writeIORef (callback ifi) f
+
+-- | Deletes the content of an 'InputField'.
+inputFieldClear :: InputField -> IO ()
+inputFieldClear ifi = do
+	(entry ifi) `set` [entryText := ""]
+	New.listStoreClear (attachments ifi)
diff --git a/Barracuda/GUI/ServerInterface.hs b/Barracuda/GUI/ServerInterface.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI/ServerInterface.hs
@@ -0,0 +1,116 @@
+-- |
+-- Maintainer: Stephan Friedrichs
+--
+-- This module represents the protocol used for communication between the gui
+-- and the server components. It is the only link between the gui and the rest
+-- of the application.
+module Barracuda.GUI.ServerInterface (
+        -- * Communication
+        ControlMessage(..),
+        ControlResponse(..),
+        MessageType(..), -- reuse GTKs message type for warning levels
+        -- * Interface
+        GUI, InfraGUI
+) where
+
+import Data.Map
+import Data.Set
+import Data.Time
+import Graphics.UI.Gtk.Windows.MessageDialog(MessageType(..))
+import Network.AdHoc.Channel
+import Network.AdHoc.Message
+import Network.AdHoc.UserID
+import Network.GnuTLS
+import Network.Socket
+
+-- | The messages sent from a graphical user interface to the Barracuda server.
+--   Note that the first message to be sent, is 'SetUser'.
+data ControlMessage
+        = SetUser
+                { suUserID :: UserID
+                , suCert   :: Certificate
+                , suKey    :: PrivateKey
+                } -- ^ Sets information about the user using the GUI.
+        | WantJoin
+                { joinChannelName :: ChannelName
+                , joinChannelID   :: ChannelID
+                } -- ^ The local user wants to join a channel.
+        | WantLeave
+                { leaveChannelName :: ChannelName
+                , leaveChannelID   :: ChannelID
+                } -- ^ The local user wants to leave a channel.
+        | SendMsg
+                { sendChannelName :: ChannelName
+                , sendChannelID   :: ChannelID
+                , sendMessage     :: String
+                , sendAttachments :: [Attachment]
+                } -- ^ The local user sent a message to a channel.
+        | CreateChannel
+                { createName        :: ChannelName
+                , createDescription :: String
+                , createInvite      :: Maybe (Set UserID) -- ^ 'Nothing' for a public channel, 'Just' inviations for a private one.
+                } -- ^ The local user wants to create a new channel.
+        | Authorize
+                { authUser        :: UserID
+                , authChannelName :: ChannelName
+                , authChannelID   :: ChannelID
+                } -- ^ The local user authorized another user to join a private channel.
+        | CMClose -- ^ The graphical user interface has been shut down. This message must
+                  --   be the last thing, a GUI sends, even if it had been closed by
+                  --   'CRClose' before.
+        deriving (Show)
+
+-- | The messages sent from the Barracuda server to the graphical user interface.
+data ControlResponse
+        = AllChans
+                { chansMap :: Map (ChannelName, ChannelID) (String, Bool, Set UserID)
+                } -- ^ A complete list of channels and the users inside each of them.
+        | Receive
+                { receiveChannelName :: ChannelName
+                , receiveChannelID   :: ChannelID
+                , receiveSender      :: Maybe UserID
+                , receiveMessage     :: String
+                , receiveAttachments :: [Attachment]
+                , receiveTimestamp   :: UTCTime
+                , receiveDelayed     :: Bool
+                } -- ^ The given message has been sent to the indicated channel.
+        | WantsAuth
+                { wantsAUser        :: UserID
+                , wantsAChannelName :: ChannelName
+                , wantsAChannelID   :: ChannelID
+                } -- ^ The indicated user requested authorization for the given private channel.
+        | ErrGeneral
+                { errGenLevel   :: MessageType
+                , errGenTitle   :: String
+                , errGenMessage :: String
+
+                } -- ^ An error occured, that has not been further specified.
+        | ErrNotDelivered
+                { errDelUsers       :: [UserID]
+                , errDelChannelName :: ChannelName
+                , errDelChannelID   :: ChannelID
+                , errDelMessage     :: String
+                , errDelAttachments :: [Attachment]
+                , errDelTime        :: UTCTime
+                } -- ^ A message could not be delivered to some users.
+        | CRClose -- ^ The user interface shall shut down.
+        deriving (Show)
+
+instance Show MessageType where
+        show MessageInfo      = "MessageInfo"
+        show MessageWarning   = "MessageWarning"
+        show MessageQuestion  = "MessageQuestion"
+        show MessageError     = "MessageError"
+        show MessageOther     = "MessageOther"
+
+-- | A function every graphical user interface for Barracuda has to provide.
+-- The first argument is a function to send a 'ControlMessage' to the server.
+-- The second argument is a function to send a 'ControlResponse' to the GUI.
+type GUI = (ControlMessage -> IO ()) -> IO (ControlResponse -> IO ())
+
+{- | A function type every infrastructure-mode configuration GUI must provide.
+   The first argument is a function the infrastructure GUI can call to change the infrastructural data.
+   The second argument is the initial configuration ('Nothing' means: inframode turned off, otherwise only the listed 'SockAddr's
+   are processed (see "Barracuda.Distributor.DistributorMsg"). -}
+type InfraGUI = (Maybe (Set SockAddr) -> IO ()) -> Maybe (Set SockAddr) -> IO ()
+
diff --git a/Barracuda/GUI/UserList.hs b/Barracuda/GUI/UserList.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI/UserList.hs
@@ -0,0 +1,62 @@
+-- |
+-- Maintainer: Henning Guenther, Oliver Mielentz
+--
+-- A widget to display the list of users in a selected channel.
+module Barracuda.GUI.UserList 
+	(UserLs()
+	--,UserID(..)
+	,userListNew
+	,userListSetUsers
+	,userListGetWidget
+	)
+	where
+
+import Control.Monad.Fix
+import Data.IORef
+import Network.AdHoc.UserID
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.ModelView as New
+
+data UserLs = UserLs 
+	{store :: New.ListStore UserID
+	,outer :: ScrolledWindow
+	,inner :: TreeView
+	}
+
+--data UserID = UserID { name :: String}
+-- | Creates a new UserList which contains the list of users and an inner TreeView and an outer ScrolledWindow.
+userListNew :: IO UserLs
+userListNew = do
+	userList <- New.listStoreNew ([] :: [UserID])
+	sw <- scrolledWindowNew Nothing Nothing
+	sw `set` [scrolledWindowHscrollbarPolicy:=PolicyAutomatic
+		 ,scrolledWindowVscrollbarPolicy:=PolicyAutomatic
+		 ,scrolledWindowShadowType:=ShadowEtchedIn]
+	tv <- New.treeViewNewWithModel userList
+	col0 <- New.treeViewColumnNew
+	col1 <- New.treeViewColumnNew
+	New.treeViewSetHeadersVisible tv False
+	
+	renderer0 <- New.cellRendererPixbufNew
+	renderer1 <- New.cellRendererTextNew
+
+	New.cellLayoutPackStart col0 renderer0 False
+	New.cellLayoutPackStart col1 renderer1 True
+	New.cellLayoutSetAttributes col0 renderer0 userList
+		$ \row -> [New.cellPixbufIconName:="stock_person"]
+	New.cellLayoutSetAttributes col1 renderer1 userList
+		$ \row -> [New.cellText:= show row]
+
+	New.treeViewAppendColumn tv col0
+	New.treeViewAppendColumn tv col1
+	sw `containerAdd` tv
+	return $ UserLs userList sw tv
+
+-- | This functions deletes the old UserList and replaces it with a new one given to the function.
+userListSetUsers :: UserLs -> [UserID] -> IO ()
+userListSetUsers ul users = do
+	New.listStoreClear(store ul)
+	mapM_ (New.listStoreAppend (store ul)) users
+-- | Returns the UserList as a Widget.
+userListGetWidget :: UserLs -> Widget
+userListGetWidget = toWidget.outer
diff --git a/Barracuda/GUI/Utils.hs b/Barracuda/GUI/Utils.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/GUI/Utils.hs
@@ -0,0 +1,17 @@
+-- |
+-- A module for supportive functions concerning the gui.
+module Barracuda.GUI.Utils where
+
+import Prelude hiding (catch)
+import Control.Exception(evaluate,catch)
+import Graphics.UI.Gtk.ModelView as New
+
+-- | Returns the list of values stored in a 'New.ListStore'.
+listStoreGetValues :: New.ListStore a -> IO [a]
+listStoreGetValues lst = getValues 0 where
+	getValues n = (do
+		x <- New.listStoreGetValue lst n
+		evaluate x
+		xs <- getValues (n+1)
+		return (x:xs)
+		) `catch` (\_ -> return [])
diff --git a/Barracuda/LocalUserInfo.hs b/Barracuda/LocalUserInfo.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/LocalUserInfo.hs
@@ -0,0 +1,50 @@
+-- |
+-- Maintainer: Stephan Friedrichs
+--
+-- A module to store all information about locally active users, i.e. users on this node, not the
+-- remote users on the network.
+module Barracuda.LocalUserInfo (
+	LocalUserInfo,
+	SingleUserInfo,
+	users,
+	channels,
+	privateKey,
+	handle,
+	userSend
+) where
+
+import Barracuda.GUI.ServerInterface
+import Data.Map as Map
+import Data.Set as Set
+import Network.AdHoc.Channel
+import Network.AdHoc.UserID
+import Network.GnuTLS.X509
+
+-- | A 'SingleUserInfo' contains the joined channels (i.e. "Set"s of 'ChannelName' and 'ChannelID'),
+-- | a private key and a reponse function for a local user.
+type SingleUserInfo = (Set.Set (ChannelName, ChannelID), PrivateKey, ControlResponse -> IO ())
+
+-- | A collection to store the 'SingleUserInfo' for locally active users (users at this node).
+type LocalUserInfo = Map UserID SingleUserInfo
+
+-- | Returns a list of all locally active users.
+users :: LocalUserInfo -> Set UserID
+users = keysSet
+
+-- | Returns the channels a given user has joined.
+channels :: UserID -> LocalUserInfo -> Maybe (Set.Set (ChannelName, ChannelID))
+channels uid info = Map.lookup uid info >>= return.(\(x, _, _) -> x)
+
+-- | Returns the private key of a given user.
+privateKey :: UserID -> LocalUserInfo -> Maybe PrivateKey
+privateKey uid info = Map.lookup uid info >>= return.(\(_, x, _) -> x)
+
+-- | Returns a function to send a 'ControlResponse' to a given users GUI.
+handle :: UserID -> LocalUserInfo -> Maybe (ControlResponse -> IO ())
+handle uid info = Map.lookup uid info >>= return.(\(_, _, x) -> x)
+
+-- | Directly sends a 'ControlResponse' to a given user. If the user is
+--   not registered, @const (return ())@ is returned.
+userSend :: UserID -> LocalUserInfo -> ControlResponse -> IO ()
+userSend user info = maybe (const $ return ()) id $ handle user info
+
diff --git a/Barracuda/PendingAck.hs b/Barracuda/PendingAck.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/PendingAck.hs
@@ -0,0 +1,73 @@
+-- |
+-- Maintainer: Henning Guenther
+--
+-- A datastructure storing messages for that we await an ACK.
+module Barracuda.PendingAck
+	(PendingAck()
+	,empty
+	,insert
+	,reinsert
+	,purgeNoAck
+	,ack
+	) where
+
+import Data.Time.Clock
+import Data.List as List hiding (insert)
+import Data.Map as Map hiding (empty,insert)
+import Data.Set as Set hiding (empty,insert)
+import qualified Data.Map as Map (empty,insert)
+import qualified Data.Set as Set (empty,insert)
+import Network.AdHoc.UserID
+import Network.AdHoc.Message
+import Network.AdHoc.MessageID
+import Network.AdHoc.Routing
+import Network.Socket(SockAddr)
+
+newtype PendingAck sign = PendingAck (Map (UserID,MessageID,SockAddr) (TTL,TargetContent,sign,UTCTime,UTCTime,Set SockAddr))
+	deriving (Show,Eq)
+
+-- | Insert a new message with the time it was received into the 'PendingAck' data structure.
+insert :: UTCTime			-- ^ The time the message was sent
+       -> Routed TargetContent sign	-- ^ The message
+       -> SockAddr			-- ^ The address the message was sent to
+       -> PendingAck sign		-- ^ The 'PendingAck'-structure in which to insert
+       -> PendingAck sign
+insert sent_time rt addr = reinsert sent_time sent_time rt addr Set.empty
+
+-- | Insert a message that already was unsuccessfully routed over a number of hosts.
+reinsert :: UTCTime			-- ^ The time the message was sent for the first time
+         -> UTCTime			-- ^ The time when the message was sent last
+	 -> Routed TargetContent sign	-- ^ The message
+	 -> SockAddr			-- ^ The address the message was sent to
+	 -> Set SockAddr		-- ^ Hosts that were unsuccessfully used in the routing process
+	 -> PendingAck sign		-- ^ The 'PendingAck'-structure in which to insert
+	 -> PendingAck sign
+reinsert sent_time ack_time (Routed ttl user msgid tc sig) addr tried (PendingAck mp)
+	= PendingAck $ Map.insert (user,msgid,addr) (ttl,tc,sig,sent_time,ack_time,tried) mp
+
+-- | Creates an empty 'PendingAck'-structure
+empty :: PendingAck sign
+empty = PendingAck Map.empty
+
+-- | Removes and returns all messages whose TTL has run out or received no ack
+purgeNoAck :: UTCTime		-- ^ Now
+	   -> NominalDiffTime	-- ^ How long to wait for an ACK-message
+	   -> PendingAck sign
+	   -> (PendingAck sign,[(Routed TargetContent sign,UTCTime,Set SockAddr)])
+purgeNoAck time ack_diff (PendingAck mp) = let
+	(purge,keep) = Map.partition
+		(\(ttl,_,_,recv_time,ack_time,_) -> ((-ack_diff) `addUTCTime` time) > ack_time
+			|| floor (diffUTCTime time recv_time) > ttl)
+		mp
+	purgeList = List.map
+		(\((receiver,msgid,sent_to),(ttl,cont,sig,recv_time,_,tried)) -> (Routed ttl receiver msgid cont sig,recv_time,Set.insert sent_to tried))
+		(Map.toList purge)
+	in (PendingAck keep,purgeList)
+
+-- | To be called when an ACK-message was received
+ack :: UserID		-- ^ User of the received ACK
+    -> MessageID	-- ^ Message-id of the received ACK
+    -> SockAddr		-- ^ The address that sent the ACK
+    -> PendingAck sign
+    -> PendingAck sign
+ack user msg addr (PendingAck mp) = PendingAck $ Map.delete (user,msg,addr) mp
diff --git a/Barracuda/PendingAnonymous.hs b/Barracuda/PendingAnonymous.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/PendingAnonymous.hs
@@ -0,0 +1,70 @@
+-- |
+-- Maintainer: Martin Wegner
+-- 
+-- A data structure used to observe the spreading of locally initiated anonymous messages.
+
+module Barracuda.PendingAnonymous
+	( PendingAnonymousMessage(..)
+	, PendingAnonymous
+	, empty
+	, insert
+	, purgeNotPosted
+	, purgeZeroTTL
+	, posted
+	)
+	where
+
+import qualified Data.Map as Map
+import Data.Time.Calendar
+import Data.Time.Clock
+
+import Network.AdHoc.Message
+import Network.AdHoc.UserID
+
+-- | An anonymous message whose posting in the anonymous channel needs to be monitored.
+data PendingAnonymousMessage = PendingAnonymousMessage
+	{ ttl         :: TTL
+	, sender      :: UserID
+	, text        :: String
+	, attachments :: [ Attachment ]
+	, time        :: UTCTime
+	}
+-- | 'PendingAnonymous' maps the identifiers of an anonymous message, the text and the time, to the rest
+--   of the attributes and a timestamp when the message was added. This way it allows the monitoring of
+--   the posting of anonymous messages and provides the ability to re-post messages that (might) have been
+--   lost during the path obscuring.
+newtype PendingAnonymous = PendingAnonymous (Map.Map (String, UTCTime) (UTCTime, TTL, UserID, [ Attachment ])) deriving (Show)
+
+-- | Builds an empty 'PendingAnonymous' structure.
+empty :: PendingAnonymous
+empty = PendingAnonymous Map.empty
+
+-- | Inserts the given message into the 'PendingAnonymous' structure.
+insert :: UTCTime -- ^ Timestamp of now.
+	-> PendingAnonymousMessage -- ^ The message to be monitored.
+	-> PendingAnonymous -> PendingAnonymous
+insert time (PendingAnonymousMessage ttl sender text attachments mtime) (PendingAnonymous pa)
+	= PendingAnonymous $ Map.insert (text, mtime) (time, ttl, sender, attachments) pa
+
+-- | Returns all anonymous messages and removes them from the structure 
+--   that were not posted and that are older than the given time.
+purgeNotPosted :: UTCTime -- ^ Timestamp of now.
+	-> NominalDiffTime -- ^ Timeout for messages. Messages that were 'insert'ed before this timeout will be returned.
+	-> PendingAnonymous
+	-> (PendingAnonymous, [ PendingAnonymousMessage ])
+purgeNotPosted now timeout (PendingAnonymous pa) = (PendingAnonymous keep, purged')
+	where
+		(keep, purged) = Map.partitionWithKey (\(_, _) (time, _, _, _) -> (time >= ((-timeout) `addUTCTime` now))) pa
+		purged'        = map (\((text, mtime), (_, ttl, sender, attachments)) -> (PendingAnonymousMessage ttl sender text attachments mtime)) $ Map.assocs purged
+
+-- | Purges all messages from the structure whose TTL elapsed.
+purgeZeroTTL :: PendingAnonymous -> PendingAnonymous
+purgeZeroTTL (PendingAnonymous pa) = PendingAnonymous $ Map.filter (\(_, ttl, _, _) -> ttl > 0) pa
+
+-- | Takes the identifiers of an anonymous message and removes it from the structure (if existing).
+posted :: String -- ^ Text of the message.
+	-> UTCTime -- ^ Timestamp of the message.
+	-> PendingAnonymous -> PendingAnonymous
+-- We do this complex check here since local 'UTCTime's contain picoseconds that we do not have from the network.
+posted text time (PendingAnonymous pa) = PendingAnonymous $ Map.filterWithKey (\(ltext, ltime) _ -> let dt = (diffUTCTime time ltime) in not (dt < -1 || dt < 1)) pa
+
diff --git a/Barracuda/PendingKey.hs b/Barracuda/PendingKey.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/PendingKey.hs
@@ -0,0 +1,54 @@
+-- |
+-- Maintainer: Martin Wegner
+--
+-- A data structure supporting the delaying of actions until the public key of some
+-- user could be retrieved over the network.
+
+module Barracuda.PendingKey
+	( PendingKey
+	, PendingKeyMessage
+	, empty
+	, insert
+	, purge
+	)
+	where
+
+import qualified Data.Map as Map
+import Data.Time.Clock
+import Network.GnuTLS.X509
+
+import Network.AdHoc.Channel
+import Network.AdHoc.Message
+import Network.AdHoc.Signature
+import Network.AdHoc.UserID
+
+-- | A message waiting for a shared key of a private channel.
+--   Can be either a local message waiting to be encrypted and sent over the network
+--   or a foreign message waiting to be decrypted and sent to local users.
+type PendingKeyMessage = Either (UserID, PrivateKey, TargetContent) (UserID, TargetContent, UTCTime, Bool)
+-- | Stores 'PendingKeyMessage's on a per-channel basis.
+newtype PendingKey = PendingKey (Map.Map (ChannelName, ChannelID) [ PendingKeyMessage ]) deriving (Show)
+
+-- | Builds an empty 'PendingKey' structure.
+empty :: PendingKey
+empty = PendingKey Map.empty
+
+-- | Inserts a 'PendingKeyMessage' for the specified channel into a 'PendingKey'.
+insert :: ChannelName -- ^ 'ChannelName' of the channel the shared key is missing for.
+	-> ChannelID -- ^ 'ChannelID' of the channel.
+	-> PendingKeyMessage -- ^ The message that cannot be de- or encrypted.
+	-> PendingKey
+	-> PendingKey
+insert cname cid msg (PendingKey pk)
+	= let msgs = case Map.lookup (cname, cid) pk of
+		Just rmsgs -> (msg:rmsgs)
+		Nothing -> [ msg ]
+	in PendingKey (Map.insert (cname, cid) msgs pk)
+
+-- | Returns all 'PendingKeyMessage's that are waiting for the key of the given channel.
+purge :: ChannelName -- ^ 'ChannelName' of channel to check for pending messages.
+	-> ChannelID -- ^ 'ChannelID' of the channel.
+	-> PendingKey
+	-> (PendingKey, Maybe [ PendingKeyMessage ]) -- ^ Returns a list of 'PendingKeyMessage's or 'Nothing' if no messages were stored.
+purge cname cid (PendingKey pk) = (PendingKey (Map.delete (cname, cid) pk), Map.lookup (cname, cid) pk)
+
diff --git a/Barracuda/PendingRoute.hs b/Barracuda/PendingRoute.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/PendingRoute.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE FlexibleContexts #-}
+-- |
+-- Maintainer: Stephan Friedrichs, Henning Guenther
+--
+-- A data structure storing the routes that some messages have failed to take, so they are not
+-- tried again.
+module Barracuda.PendingRoute (
+	PendingRoute,
+	empty,
+	insert,
+	reinsert,
+	routeAndDelete,
+	purgeZeroTTL
+) where
+
+import Barracuda.RoutingTable hiding (empty)
+import Barracuda.TimedCollection
+import qualified Data.Heap as Heap
+import qualified Data.Map as Map
+import Data.Ord (comparing)
+import Data.Maybe
+import qualified Data.Set as Set
+import Data.Time
+import Network.AdHoc.Message
+import Network.AdHoc.Routing
+import Network.Socket
+
+newtype RoutedInfo sign = RoutedInfo (UTCTime, Routed TargetContent sign, Set.Set SockAddr) deriving (Show)
+
+instance Eq (RoutedInfo sign) where
+	a == b = timeOut a == timeOut b
+
+instance Ord (RoutedInfo sign) where
+	compare = comparing timeOut
+
+newtype PendingRoute sign = NackHeap (Heap.MinHeap (RoutedInfo sign)) deriving (Show, Eq, Ord)
+
+timeOut :: RoutedInfo sign -> UTCTime
+timeOut (RoutedInfo (recv, Routed ttl _ _ _ _, _)) = (fromInteger $ toInteger ttl) `addUTCTime` recv
+
+instance TimedCollection (PendingRoute sign) where
+	deleteBefore now nacks@(NackHeap heap) = if now > minDeadline
+		then nacks
+		else deleteBefore now $ NackHeap heap'
+		where (RoutedInfo (minDeadline, _, _), heap') = Heap.extractHead heap
+
+-- | Creates an empty 'PendingRoute'.
+empty :: PendingRoute sign
+empty = NackHeap Heap.empty
+
+-- | Inserts a new 'Routed' element into the 'PendingRoute'. If there already are hosts
+--   that have to be ignored furtheron, use 'reinsert'.
+insert :: UTCTime               -- ^ The current point of time.
+	-> Routed TargetContent sign -- ^ The message to be saved.
+	-> PendingRoute sign -> PendingRoute sign
+insert now rtc nacks = reinsert now rtc Set.empty nacks
+
+-- | Inserts a new 'Routed' element into the 'PendingRoute'. It also saves routes that
+--   already have been (unsuccessfully) tried before. Compare to 'insert'.
+reinsert :: UTCTime             -- ^ The current point of time.
+	-> Routed TargetContent sign -- ^ The message to be saved.
+	-> Set.Set SockAddr     -- ^ A set of routers that were not able to route the message.
+	-> PendingRoute sign -> PendingRoute sign
+reinsert now rtc set (NackHeap heap) = NackHeap $ Heap.insert (RoutedInfo (deadline, rtc, set)) heap
+	where	deadline = toEnum (fromEnum (routedTTL rtc)) `addUTCTime` now
+
+-- | Tries to reroute stored messages. The function looks at every stored message and
+--   proposes a new route. This new route is added to the set of already attempted hosts.
+--   All messages with a new route-proposal are removed from the original 'PendingRoute', so
+--   only the \"hopeless cases\" remain within.
+routeAndDelete :: RoutingStrategy (r,Set.Set SockAddr) =>
+	r           -- ^ The 'RoutingTable' with the routing information.
+	-> PendingRoute sign -- ^ The 'PendingRoute' storing nacked messages.
+	-> (PendingRoute sign, [(SockAddr,Routed TargetContent sign, Set.Set SockAddr,UTCTime)])
+	            -- ^ Tuples of messages where a new route has been found. It contains the
+		    --   message itself, a set of attempted routes (including the new one) and
+		    --   a new router to be tried. The new 'PendingRoute' does not contain the
+		    --   newly routed elements.
+routeAndDelete table (NackHeap heap) = let
+	routingResults = map (\(RoutedInfo (deadline, msg, failedRoutes)) ->
+		(deadline,failedRoutes,route (table,failedRoutes) msg)
+		) (Heap.toAscList heap)
+	noRoutes = catMaybes $ map (\(deadline,failedRoutes,(_,msg)) ->
+		msg >>= \rmsg -> return $ RoutedInfo (deadline,rmsg,failedRoutes)
+		) routingResults
+	routes = concatMap (\(deadline,failed,(mp,_)) ->
+		map (\(addr,msg) -> (addr,msg,failed,deadline)) (Map.toList mp)
+		) routingResults
+	in (NackHeap $ Heap.fromAscList noRoutes,routes)
+
+purgeZeroTTL :: UTCTime -> PendingRoute sign -> (PendingRoute sign,[Routed TargetContent sign])
+purgeZeroTTL now (NackHeap heap) = let
+	(removed', nheap) = Heap.span (\ri -> timeOut ri >= now) heap
+	removed = map (\(RoutedInfo (_, msg, _)) -> msg { routedTTL = 0 }) removed'
+	in (NackHeap nheap,removed)
diff --git a/Barracuda/RoutingTable.hs b/Barracuda/RoutingTable.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/RoutingTable.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
+-- | Maintainer: Stephan Friedrichs
+--
+-- This module stores the entire routing logic of our implementation.
+module Barracuda.RoutingTable (
+	-- * Routing
+	-- ** Definition
+	RoutingStrategy(..), RoutingTable(..),
+	-- ** Implementation
+	SimpleRT,
+	-- * Configuration
+	hopMax
+) where
+
+import Barracuda.TimedCollection
+import Data.Foldable as Foldable
+import qualified Data.List as List
+import qualified Data.Map as Map
+import Data.Maybe
+import qualified Data.Set as Set
+import Data.Time
+import Network.AdHoc.Routing -- as Routing
+import Network.AdHoc.UserID
+import Network.Socket
+
+-- | A routing table is an efficient data structure for the handling of routing
+--   information. It must maintain a list of hosts together with the
+--   information which users it knows and how many hops it takes to reach them.
+class (TimedCollection r, RoutingStrategy r, RoutingStrategy (r, Set.Set SockAddr)) =>
+		RoutingTable r where
+	-- | Construct an empty routing table.
+	empty               :: r
+	-- | Updates the routing table with information about which users
+	--   reside on a given host. Usually obtained through a HELLO protocol-message.
+	hello               :: UTCTime -> SockAddr -> [UserID] -> r -> r
+	-- | Given a timestamp, a 'SockAddr' and the routing table of a host,
+	--   this function updates the available routing information. This
+	--   information is usually provided by a ROUTING protocol-message,
+	--   therefore each hop count is increased by 1.
+	routing             :: UTCTime -> SockAddr -> [(UserID, Int)] -> r -> r
+	-- | Deletes a given host and all related routing information from the
+	--   routing table. Usually this is triggered by that host leaving the
+	--   transmission range.
+	delete              :: SockAddr -> r -> r
+	-- | Gives a set of all users that are known through the information
+	--   in the routing table.
+	userList            :: r -> Set.Set UserID
+	-- | Merges all known routes to one map. The 'Set.Set' of 'UserID' are the local
+	--   users that are deleted from the data.
+	mergeRoutes         :: Set.Set UserID -> r -> Map.Map UserID Int
+	-- | Put together routing informations that have to be send to a given
+	--   host, wich includes deleting the routing information from that host.
+	--   The 'Set.Set' of 'UserID' are the local users that are removed from the
+	--   returned 'Map.Map'.
+	--   This function does not have to be implemented, there is a default implementation.
+	mergeRoutesFor      :: SockAddr -> Set.Set UserID -> r -> Map.Map UserID Int
+	mergeRoutesFor addr users = (mergeRoutes users).(delete addr)
+	-- | Get a set of direct neighbors (nodes that are reachable without routing).
+	neighbors           :: r -> Set.Set SockAddr
+
+-- | The default implementation of 'RoutingTable'.
+newtype SimpleRT = SimpleRT (Map.Map SockAddr (UTCTime, Set.Set UserID, Map.Map UserID Int)) deriving Show
+
+instance TimedCollection SimpleRT where
+	deleteBefore time (SimpleRT mp)   = SimpleRT $ Map.filter ((>=time).(\(x, _, _) -> x)) mp
+
+instance RoutingStrategy SimpleRT where
+	routeSingle user tb = routeSingle user (tb, Set.empty :: Set.Set SockAddr)
+
+instance RoutingStrategy (SimpleRT, Set.Set SockAddr) where
+	routeSingle user (SimpleRT mp, hosts)
+		| null routes             = Nothing
+		| otherwise               = Just (fst $ minRoute routes)
+		where
+		allPeers       = Map.assocs mp
+		routes         = directRoutes ++ indirectRoutes
+		directRoutes   = mapMaybe (\(k, (_, set, _)) -> if Set.member user set && Set.notMember k hosts
+				then Just (k, 1)
+				else Nothing
+			) allPeers
+		indirectRoutes = mapMaybe (\(k, (_, _, table)) -> do
+				hops <- Map.lookup user table
+				if Set.member k hosts then fail "ignored host" else return (k, hops)
+			) allPeers
+
+-- | Find the shortest route. The only difference to @minimumBy (comparing snd)@ is, that this
+--   function immediately returns a route with 1 hop. This function is undefined for an empty list.
+minRoute :: [(a, Int)] -> (a, Int)
+minRoute []             = error "Barracuda.RoutingTable.minRoute: empty list"
+minRoute [tuple]        = tuple
+minRoute ((x, hops):xs) = if hops <= 1
+	then (x, hops)
+	else let (x', hops') = minRoute xs in if hops < hops'
+		then (x, hops)
+		else (x', hops')
+
+instance RoutingTable SimpleRT where
+	empty                              = SimpleRT Map.empty
+	hello time addr xs (SimpleRT mp)   = SimpleRT $ Map.insertWith (\(t1, h, _) (t2, _, r) -> (max t1 t2, h, r))
+		addr (time, Set.fromList xs, Map.empty) mp
+	routing time addr xs (SimpleRT mp) = SimpleRT $ Map.insertWith (\(t1, _, r) (t2, h, _) -> (max t1 t2, h, r))
+		addr (time, Set.empty, routingMessage) mp
+		where routingMessage = Map.fromList $ filter (\(_, h) -> h <= hopMax) $ map (\(u, h) -> (u, h + 1)) xs
+	delete addr (SimpleRT mp)          = SimpleRT $ Map.delete addr mp
+	userList (SimpleRT mp)             = Set.unions [ helloUsers | (_, helloUsers, _) <- values ]
+		`Set.union` Set.unions [ Map.keysSet routingUsers | (_, _, routingUsers) <- values ]
+		where values = Map.elems mp
+	mergeRoutes users (SimpleRT mp)    = (flip (Foldable.foldl (\m user -> Map.insert user 0 m))) users -- add local users
+		$ Map.unionsWith min                       -- always prefer shorter over long routes: length does not count :P
+		$ fmap (\(_, h, r) -> Foldable.foldl (\mp u -> Map.insert u 1 mp) r h) -- prefer users from hello over indirect
+		$ Map.elems mp                                                         -- routing info
+	neighbors (SimpleRT mp)            = Map.keysSet mp
+
+instance RoutingStrategy (SimpleRT, Set.Set UserID) where
+	routeSingle user (rt, _)           = routeSingle user rt
+	routeMulti users (rt, locals)      = routeMulti (List.filter (\x -> Set.member x locals) users) rt
+
+-- | The upper hop-limit for routig entries. It is used to detect dead
+--   entries in routing messages.
+hopMax :: Num n => n
+hopMax = 360
+
diff --git a/Barracuda/ServerState.hs b/Barracuda/ServerState.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/ServerState.hs
@@ -0,0 +1,383 @@
+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}
+-- | Maintainer: Henning Guenther, Martin Wegner, Stephan Friedrichs
+--
+-- This module contains a monad encapsulating the entire status of the distributor, so that it
+-- is completely free of side-effects. As a consequence, dumping the 'ServerState' gives all
+-- information about why the distributor has made any decision.
+module Barracuda.ServerState (
+	-- * Types
+	ServerMonad,
+	ServerState(..),
+	CertificateCallback,
+	CertificateRequest,
+	Accessor,
+	SendCB,
+	-- * Monadic operations
+	-- ** Running the ServerMonad
+	runServerMonad,
+	-- ** Retrieving IDs
+	newMessageId,
+	newChannelId,
+	-- ** Sending messages
+	sendMessage,
+	sendMessageBroadcast,
+	sendUser,
+	sendUserBroadcast,
+	-- ** Accessing attributes
+	-- *** General accessors
+	with,
+	query,
+	manipulate,
+	-- *** Shortcuts
+	withCertificateRequests,
+	withCertificates,
+	withTimeOffsets,
+	withChannelList,
+	withLocalUserInfo,
+	withPendingAck,
+	withPendingAnonymous,
+	withPendingKey,
+	withPendingRoute,
+	withRandom,
+	newRandom,
+	withRoutingTable,
+	-- ** Other accessors
+	rootCertificate,
+	curTime,
+	shutdown,
+	-- ** Auxiliary functions
+	floodAgain,
+	isLocal,
+	partitionLocals,
+	-- * Logging and debugging
+	btrace,
+	berror
+) where
+
+import Barracuda.CertificateList hiding (certificates)
+import Barracuda.ChannelList as CL
+import Barracuda.RoutingTable as RT
+import Barracuda.LocalUserInfo
+import Barracuda.PendingAck as PAck
+import Barracuda.PendingRoute as PRoute
+import Barracuda.PendingAnonymous as PAnon
+import Barracuda.PendingKey as PKey
+import Barracuda.GUI.ServerInterface hiding (sendMessage)
+import Barracuda.Utils
+import Control.Monad.State hiding (mapM_)
+import Prelude hiding (mapM_)
+import Data.Foldable
+import Data.List as List
+import Data.Map as Map
+import Data.Monoid
+import Data.Sequence as Seq
+import Data.Set as Set
+import Data.Time.Clock
+import Data.Word
+import Network.AdHoc.UserID
+import Network.AdHoc.Channel
+import Network.AdHoc.Message
+import Network.AdHoc.MessageID
+import Network.AdHoc.Routing
+import Network.AdHoc.Signature
+import Network.GnuTLS.X509
+import Network.Socket hiding (Debug, shutdown)
+import System.IO
+import System.Random as Random
+import System.Posix.Unistd
+
+-- | Queue that holds the messages to be sent to the network.
+type OutQueue = Seq (SockAddr, InternalMessage)
+-- | Queue that holds the 'ControlResponse's to be sent to locally connected users.
+type UserQueue = Seq (UserID, ControlResponse)
+
+-- | States how severe a given message is
+data Severity
+	= Debug	-- ^ The message is only relevant for debugging purposes
+	| Error	-- ^ The message informs about an error that should not happen
+	deriving (Show,Eq)
+
+-- | Queue that contains output messages.
+type PrintQueue = Seq (Severity, String)
+-- | Required callback type for functions that want to be called when open certificate requests have been answered.
+type CertificateCallback = Map UserID Certificate -> ServerMonad ()
+-- | Holds one certificate request. The first set holds all 'UserID's we wait for a certificate from,
+--   the second map holds the already satisfied certificates and the third element is the callback
+--   to be called when all requests are satisfied.
+type CertificateRequest = (Set UserID, Map UserID Certificate, CertificateCallback)
+
+-- | A 'Monad' ('MonadState') wrapping the 'ServerState' and queues for output.
+data ServerMonad a = ServerMonad (HostAddress -> Certificate -> UTCTime -> ServerState -> (PrintQueue, OutQueue, UserQueue, ServerState, a))
+
+-- | The state of the server. It holds all relevant data structures that store on the one hand
+--   information about the network and on the other hand the internal state of certain data such as
+--   open certificate requests and different structures waiting for different events (Pending*).
+data ServerState = ServST
+	{ routingTable        :: SimpleRT -- ^ The currently known routing table to be used to route messages.
+	, chanList            :: ChannelMap -- ^ The list of currently known public and private channels.
+	, localUserInfo       :: LocalUserInfo -- ^ Stores information ('UserID', 'PrivateKey', joined channels and a handle to send messages to the GUI of the user) about all locally connected users.
+	, certificates        :: CertificateList -- ^ Stores all known certificates.
+	, certificateRequests :: [ CertificateRequest ] -- ^ Stores a list of 'CertificateRequest's waiting for certain certificates.
+	, userTimeOffsets     :: Map.Map UserID (UTCTime, UTCTime) -- ^ The time offsets to remote users.
+	, randGen             :: StdGen -- ^ Stores a random number generator.
+	, pendingAck          :: PendingAck InternalSignature -- ^ Stores messages that an ACK is awaited for.
+	, pendingAnonymous    :: PendingAnonymous -- ^ Stores anonymous messages to be monitored to be actually posted to the anonymous channel.
+	, pendingKey          :: PendingKey -- ^ Stores messages to be de- or encrypted that are waiting for a shared key of a channel.
+	, pendingRoute        :: PendingRoute InternalSignature -- ^ Stores messages that are waiting for a route to their destinations.
+	, msgIds              :: [MessageID] -- ^ An infinite list of unused 'MessageID's.
+	, channelIdCounter    :: Integer -- ^ Counter for the 'ChannelID's we use.
+	, infrastructure      :: Maybe (Set SockAddr) -- ^ Maybe stores a set of peers we are (only) connected with.
+	, floodBuffer         :: [(UserID, MessageID)] -- ^ Stores information about last received flood messages.
+	, nextRouting         :: UTCTime -- ^ Timestamp when routing messages have to be sent the next time.
+	, verbose             :: Bool -- ^ Whether to be verbose or not in output.
+	, localhost           :: String -- ^ Local hostname.
+	, localhostAddr       :: SockAddr -- ^ The local ip and port.
+	, wantsShutdown       :: Bool   -- ^ The server wants to be shut down. Access this flag by 'shutdown' rather than directly.
+	}
+
+instance Monad ServerMonad where
+	return x = ServerMonad (\_ _ _ st -> (Seq.empty, Seq.empty, Seq.empty, st, x))
+	(ServerMonad f) >>= g = ServerMonad (\bcast cert time st -> let
+		(printSeq, outSeq, clSeq, nst, res) = f bcast cert time st
+		ServerMonad f2 = g res
+		(printSeq2, outSeq2, clSeq2, nnst, res2) = f2 bcast cert time nst
+		in (printSeq >< printSeq2, outSeq >< outSeq2, clSeq >< clSeq2, nnst, res2)
+		)
+
+instance MonadState ServerState ServerMonad where
+	get = ServerMonad (\_ _ _ st -> (Seq.empty, Seq.empty, Seq.empty, st, st))
+	put nst = ServerMonad (\_ _ _ _ -> (Seq.empty, Seq.empty, Seq.empty, nst, ()))
+
+-- | Creates the initial state of the "ServerState", takes the current time, a
+--   random number generator to be used subsequently, the 'SockAddr' of the host
+--   we are running on and a boolean signalling whether to be verbose or not.
+initialState :: UTCTime -> StdGen -> Bool -> String -> SockAddr -> ServerState
+initialState now gen v host addr = let (gen1, gen2) = Random.split gen in ServST
+	{ routingTable        = RT.empty
+	, chanList            = mempty
+	, localUserInfo       = Map.empty
+	, certificates        = Map.empty
+	, certificateRequests = []
+	, userTimeOffsets     = Map.empty
+	, randGen             = gen1
+	, pendingAck          = PAck.empty
+	, pendingAnonymous    = PAnon.empty
+	, pendingKey          = PKey.empty
+	, pendingRoute        = PRoute.empty
+	, msgIds              = scrambler 100 gen2 -- scramble order of ids to prevent
+	, channelIdCounter    = 0                  -- attacks, e.g. on ANONYMOUS
+	, infrastructure      = Nothing
+	, floodBuffer         = []
+	, nextRouting         = now
+	, verbose             = v
+	, localhost           = host
+	, localhostAddr       = addr
+	, wantsShutdown       = False
+	}
+
+-- | Generates a new unique 'MessageID'.
+newMessageId :: ServerMonad MessageID
+newMessageId = with (msgIds) (\newIds state -> state { msgIds = newIds }) (\list -> (tail list, head list))
+
+-- | Retrieves the broadcast ip address.
+getBroadcastAddress :: ServerMonad HostAddress
+getBroadcastAddress = ServerMonad (\bcast _ _ st -> (Seq.empty, Seq.empty, Seq.empty, st, bcast))
+
+-- | Generates a new unique 'ChannelID'.
+newChannelId :: ServerMonad ChannelID
+newChannelId = do
+	st <- get
+	let val = (channelIdCounter st) + 1
+	put (st {channelIdCounter = val})
+	host <- gets localhost
+	return (ChannelID (show val) host)
+
+-- | Queues a message to be sent to the network.
+sendMessage :: SockAddr -> InternalMessage -> ServerMonad ()
+sendMessage addr msg = ServerMonad (\_ _ _ st -> (Seq.empty, Seq.singleton (addr, msg), Seq.empty, st, ()))
+
+-- | Takes a message to be broadcastet to the network and sends it.
+sendMessageBroadcast :: InternalMessage -> ServerMonad ()
+sendMessageBroadcast msg = do
+	st <- get
+	case infrastructure st of
+		Nothing -> do    -- We're not in infrastrucure-mode, so broadcast the message to everyone
+			bcast <- getBroadcastAddress
+			sendMessage (SockAddrInet 8888 bcast) msg
+		Just hosts -> do -- We are in infrastructure-mode, send explicit messages to everyone we know
+			localhost <- gets localhostAddr -- make sure, we receive our own broadcast
+			mapM_ (\host -> sendMessage host msg) (Set.insert localhost hosts)
+
+-- | Sends the given 'ControlResponse' to the given user's GUI.
+sendUser :: UserID -> ControlResponse -> ServerMonad ()
+sendUser user msg = ServerMonad (\_ _ _ st -> (Seq.empty, Seq.empty, Seq.singleton (user, msg), st, ()))
+
+-- | Sends the given 'ControlResponse' to the GUIs of all connected users.
+sendUserBroadcast :: ControlResponse -> ServerMonad ()
+sendUserBroadcast msg = do
+	locals <- withLocalUserInfo $ query users
+	mapM_ (flip sendUser msg) locals
+
+-- | Returns the current time.
+curTime :: ServerMonad UTCTime
+curTime = ServerMonad (\_ _ time st -> (Seq.empty, Seq.empty, Seq.empty, st, time))
+
+-- | Returns the root certificate used to verify all other certificates.
+rootCertificate :: ServerMonad Certificate
+rootCertificate = ServerMonad (\_ cert _ st -> (Seq.empty, Seq.empty, Seq.empty, st, cert))
+
+-- | Shut down the server. This is not rather done after processing the current 'DistributorMsg'
+--   than immediately.
+shutdown :: ServerMonad ()
+shutdown = do
+	btrace "Requesting server shutdown"
+	modify (\st -> st { wantsShutdown = True })
+
+-- | Such a function has to be provided to 'runServerMonad' in order to enable it
+--   to perform necessary network output.
+-- The first argument is an infinite list of unused 'MessageID's.
+-- The second argument is the target network address.
+-- The third argument is a message that has to be sent.
+-- The result is another infinite list of unused 'MessageID's. The ones used must be removed.
+type SendCB = [MessageID] -> SockAddr -> InternalMessage -> IO [MessageID]
+
+-- | This function actually runs the entire 'ServerMonad' structure. Given some
+--   configurational parameters and a callback to perform network output, it takes
+--   a list of timestamped instructions and performs the resulting IO.
+runServerMonad :: SendCB               -- ^ A send callback that performs pending network operations.
+	-> Bool                        -- ^ Indicates weather we're verbosed or not.
+	-> HostAddress                 -- ^ The broadcast address to use
+	-> Certificate                 -- ^ The root certificate for the network.
+	-> PortNumber		       -- ^ The portnumber, used for hostname generation
+	-> [(UTCTime, ServerMonad ())] -- ^ The actual list of timestamped operations to perform.
+	-> IO ()
+runServerMonad send v bcast cert pn xs = do
+	gen <- newStdGen
+	now <- getCurrentTime
+	host <- getSystemID >>= return.nodeName
+	certDir <- getCertificateDirectory
+	loadedCerts <- loadCertificateList certDir
+	localhost <- inet_addr "127.0.0.1"
+	let state = initialState now gen v (host ++ (if pn == 8888 then "" else '_':show pn)) (SockAddrInet pn localhost)
+	runServerMonad' send bcast cert xs (state { certificates = loadedCerts })
+
+runServerMonad' :: SendCB -> HostAddress -> Certificate -> [(UTCTime,ServerMonad ())] -> ServerState -> IO ()
+runServerMonad' _ _ _ [] st = do
+	certDir <- getCertificateDirectory
+	dumpCertificateList (certificates st) certDir
+runServerMonad' send bcast cert ((time, ServerMonad f):xs) st = let
+	(print, out, out_user, nst, _) = f bcast cert time st
+	in do
+		mapM_ (\(sev, text) -> hPutStrLn (case sev of
+			Debug -> stdout
+			Error -> stderr) text) (viewl print)
+		nids <- foldlM (\ids -> uncurry (send ids)) (msgIds nst) (viewl out)
+		mapM_ (\(user, msg) -> userSend user (localUserInfo nst) msg) (viewl out_user)
+		runServerMonad' send bcast cert (if wantsShutdown nst then [] else xs) (nst {msgIds = nids})
+
+-- | Type specification for accessor functions (i. e. functions that work on the data structures in the "ServerState").
+type Accessor a b = (a -> (a,b)) -> ServerMonad b
+
+-- | The general accessor for The 'ServerState', that makes its attributs available in a
+--   monadic calculation. See also: 'query' and 'manipulate', they make things easier.
+with :: (ServerState -> a)                   -- ^ A getter function.
+	-> (a -> ServerState -> ServerState) -- ^ The setter function.
+	-> Accessor a b                      -- ^ Allows monadic access according to the callbacks above.
+with getter setter f = do
+	st <- get
+	let (new,res) = f (getter st)
+	put (setter new st)
+	return res
+
+-- | Gives access for querying and manipulating the routing table.
+withRoutingTable :: Accessor SimpleRT b
+withRoutingTable = with routingTable (\rt st -> st {routingTable = rt})
+
+-- | Gives access for querying and manipulating the channel list.
+withChannelList :: Accessor ChannelMap b
+withChannelList = with chanList (\cl st -> st {chanList = cl})
+
+-- | Gives access for querying and manipulating the local user info.
+withLocalUserInfo :: Accessor LocalUserInfo b
+withLocalUserInfo = with localUserInfo (\li st -> st {localUserInfo = li})
+
+-- | Gives access for querying and manipulating the pending ack data structure.
+withPendingAck :: Accessor (PendingAck InternalSignature) b
+withPendingAck = with pendingAck (\pa st -> st {pendingAck = pa})
+
+-- | Gives access for querying and manipulating the pending anonymous data structure.
+withPendingAnonymous :: Accessor PendingAnonymous b
+withPendingAnonymous = with pendingAnonymous (\pa st -> st {pendingAnonymous = pa})
+
+-- | Gives access for querying and manipulating the pending key data structure.
+withPendingKey :: Accessor PendingKey b
+withPendingKey = with pendingKey (\pk st -> st {pendingKey = pk})
+
+-- | Gives access for querying and manipulating the pending route data structure.
+withPendingRoute :: Accessor (PendingRoute InternalSignature) b
+withPendingRoute = with pendingRoute (\pr st -> st {pendingRoute = pr})
+
+-- | Gives access for querying and manipulating the random generator.
+withRandom :: Accessor (StdGen) b
+withRandom = with randGen (\gen st -> st {randGen = gen})
+
+-- | Returns a new random generator
+newRandom :: ServerMonad StdGen
+newRandom = withRandom (Random.split)
+
+-- | Gives access for querying and manipulating the certificate list.
+withCertificates :: Accessor CertificateList b
+withCertificates = with certificates (\lst st -> st {certificates = lst})
+
+-- | Gives access for querying and manipulating the certificate request list.
+withCertificateRequests :: Accessor [ CertificateRequest ] b
+withCertificateRequests = with certificateRequests (\reqs st -> st {certificateRequests = reqs})
+
+-- | Gives access for querying and manipulating the user time offset list.
+withTimeOffsets :: Accessor (Map UserID (UTCTime, UTCTime)) b
+withTimeOffsets = with userTimeOffsets (\to st -> st {userTimeOffsets = to})
+
+-- | Helper to wrap modifying \"non-monad functions\" to work with the 'ServerMonad'.
+manipulate :: (a -> a) -> (a -> (a,()))
+manipulate f x = (f x,())
+
+-- | Helper to wrap querying \"non-monad functions\" to work with the 'ServerMonad'.
+query :: (a -> b) -> (a -> (a,b))
+query f x = (x,f x)
+
+-- | Checks whether a flood message identified by the given 'UserID' and 'MessageID' was already received before.
+floodAgain :: UserID -> MessageID -> ServerMonad Bool
+floodAgain user msgid = do
+	st <- get
+	if (user,msgid) `List.elem` (floodBuffer st)
+		then return False
+		else put (st {floodBuffer = (user,msgid):(List.take 9 $ floodBuffer st)}) >> return True
+
+-- | Checks whether the given 'UserID' identifies a locally connected user or not.
+isLocal :: UserID -> ServerMonad Bool
+isLocal user = do
+	st <- get
+	return $ Map.member user (localUserInfo st)
+
+-- | Splits a given set of users into (locals,non-locals)
+partitionLocals :: Set UserID -> ServerMonad (Set UserID,Set UserID)
+partitionLocals users = do
+	locals <- get >>= return.keysSet.localUserInfo
+	return $ Set.partition (\el -> Set.member el locals) users
+
+-- | Used for rather verbosed output, for example for keeping track of an attribute. It
+--   only performs the output, if 'verbose' is activated. For error messages use
+--   'berror', to be sure it's printed!
+btrace :: String -> ServerMonad ()
+btrace text = gets verbose >>= \v -> if v then bprint Debug text else return ()
+
+-- | Used for error output. This functions also performs output if 'verbose' is deactivated.
+--   See also: 'btrace'.
+berror :: String -> ServerMonad ()
+berror text = bprint Error text
+
+-- | Appends a text to be printed and the concerning 'Severity' to the 'PrintQueue'.
+bprint :: Severity -> String -> ServerMonad ()
+bprint sev text = ServerMonad (\_ _ time st ->
+	(Seq.singleton (sev, show time ++ "\t" ++ text), Seq.empty, Seq.empty, st, ()))
+
diff --git a/Barracuda/TimedCollection.hs b/Barracuda/TimedCollection.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/TimedCollection.hs
@@ -0,0 +1,18 @@
+-- |
+-- Maintainer: Stephan Friedrichs
+--
+-- A generalization of collections storing timestamped data.
+
+module Barracuda.TimedCollection (
+	TimedCollection(..)
+) where
+
+import Data.Time
+
+-- | Represents a collection that contains timestamped information. This
+--   collection can be purged by deleting all information older than a given
+--   point of time.
+class TimedCollection t where
+	-- | Deletes all information before the given timestamp.
+	deleteBefore :: UTCTime -> t -> t
+
diff --git a/Barracuda/Utils.hs b/Barracuda/Utils.hs
new file mode 100644
--- /dev/null
+++ b/Barracuda/Utils.hs
@@ -0,0 +1,62 @@
+-- |
+-- Maintainer: Stephan Friedrichs, Henning Guenther
+--
+-- This module provides a bundle of helper-functions used in several
+-- places of the software.
+module Barracuda.Utils where
+
+import Prelude hiding (catch)
+import Control.Exception (catch)
+import Data.Char
+import System.Directory
+import Network.Socket
+import System.FilePath
+import System.IO.Unsafe
+
+-- | Reads a hostname to a 'String', if possible.
+readHost :: String -> Maybe HostAddress
+readHost str = unsafePerformIO $
+	(inet_addr str >>= return.Just) `catch` (\err -> return Nothing)
+
+-- | Does the same as 'readHost', only that it throws an error on failure.
+readHost' :: String -> HostAddress
+readHost' str = maybe (error $ "Couldn't parse address "++str) id (readHost str)
+
+-- | Parses a 'String' into a 'SockAddr'.
+readSockAddr :: PortNumber -- ^ The default portnumber to use, if none is given in the 'String'.
+	-> String          -- ^ This is where the 'SockAddr' is parsed from.
+	-> Maybe SockAddr
+readSockAddr def str = do
+	let (ip,rest) = break (==':') str
+	host <- readHost ip
+	case rest of
+		[]       -> return $ SockAddrInet def host
+		':':port -> if all isDigit port
+			then return $ SockAddrInet (fromIntegral $ read port) host
+			else fail "couldn't parse port"
+		_        -> fail "':' expected"
+
+-- | The same as 'readSockAddr', only that an error is thrown on failure.
+readSockAddr' :: PortNumber -> String -> SockAddr
+readSockAddr' def str = maybe (error $ "Couldn't parse address "++str) id (readSockAddr def str)
+
+-- | Converts a 'HostAddress' to a 'String'.
+showHost :: HostAddress -> String
+showHost = unsafePerformIO.inet_ntoa
+
+-- | Returns the directory where the configuration is saved.
+getConfigDirectory :: IO FilePath
+getConfigDirectory = getHomeDirectory >>= return.(</> ".barracuda")
+
+-- | The root directrory of the certificate cache.
+getCertificateDirectory :: IO FilePath
+getCertificateDirectory = getConfigDirectory >>= return.(</> "certificates")
+
+-- | A file saving the most recently used certificate.
+getLastCertificate :: IO FilePath
+getLastCertificate = getConfigDirectory >>= return.(</> "last-cert")
+
+-- | A file saving the most recently used private key.
+getLastKey :: IO FilePath
+getLastKey = getConfigDirectory >>= return.(</> "last-key")
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,674 @@
+                    GNU GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+  The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.  We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors.  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+  To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights.  Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received.  You must make sure that they, too, receive
+or can get the source code.  And you must show them these terms so they
+know their rights.
+
+  Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+  For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software.  For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+  Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so.  This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software.  The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable.  Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products.  If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+  Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary.  To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                       TERMS AND CONDITIONS
+
+  0. Definitions.
+
+  "This License" refers to version 3 of the GNU General Public License.
+
+  "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+  "The Program" refers to any copyrightable work licensed under this
+License.  Each licensee is addressed as "you".  "Licensees" and
+"recipients" may be individuals or organizations.
+
+  To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy.  The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+  A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+  To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy.  Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+  To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies.  Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+  An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License.  If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+  1. Source Code.
+
+  The "source code" for a work means the preferred form of the work
+for making modifications to it.  "Object code" means any non-source
+form of a work.
+
+  A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+  The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form.  A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+  The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities.  However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work.  For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+  The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+  The Corresponding Source for a work in source code form is that
+same work.
+
+  2. Basic Permissions.
+
+  All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met.  This License explicitly affirms your unlimited
+permission to run the unmodified Program.  The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work.  This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+  You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force.  You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright.  Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+  Conveying under any other circumstances is permitted solely under
+the conditions stated below.  Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+  No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+  When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+  4. Conveying Verbatim Copies.
+
+  You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+  You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+  5. Conveying Modified Source Versions.
+
+  You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+    a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+
+    b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under section
+    7.  This requirement modifies the requirement in section 4 to
+    "keep intact all notices".
+
+    c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy.  This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged.  This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+
+    d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+  A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit.  Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+  6. Conveying Non-Source Forms.
+
+  You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+    a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+
+    b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the
+    Corresponding Source from a network server at no charge.
+
+    c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source.  This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+
+    d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge.  You need not require recipients to copy the
+    Corresponding Source along with the object code.  If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source.  Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+
+    e) Convey the object code using peer-to-peer transmission, provided
+    you inform other peers where the object code and Corresponding
+    Source of the work are being offered to the general public at no
+    charge under subsection 6d.
+
+  A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+  A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling.  In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage.  For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product.  A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+  "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source.  The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+  If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information.  But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+  The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed.  Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+  Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+  7. Additional Terms.
+
+  "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law.  If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+  When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it.  (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.)  You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+  Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+    a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+
+    b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+
+    c) Prohibiting misrepresentation of the origin of that material, or
+    requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+
+    d) Limiting the use for publicity purposes of names of licensors or
+    authors of the material; or
+
+    e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+
+    f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions of
+    it) with contractual assumptions of liability to the recipient, for
+    any liability that these contractual assumptions directly impose on
+    those licensors and authors.
+
+  All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10.  If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term.  If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+  If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+  Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+  8. Termination.
+
+  You may not propagate or modify a covered work except as expressly
+provided under this License.  Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+  However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+  Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+  Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License.  If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+  9. Acceptance Not Required for Having Copies.
+
+  You are not required to accept this License in order to receive or
+run a copy of the Program.  Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance.  However,
+nothing other than this License grants you permission to propagate or
+modify any covered work.  These actions infringe copyright if you do
+not accept this License.  Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+  10. Automatic Licensing of Downstream Recipients.
+
+  Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License.  You are not responsible
+for enforcing compliance by third parties with this License.
+
+  An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations.  If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+  You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License.  For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+  11. Patents.
+
+  A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based.  The
+work thus licensed is called the contributor's "contributor version".
+
+  A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version.  For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+  Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+  In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement).  To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+  If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients.  "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+  If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+  A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License.  You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+  Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+  12. No Surrender of Others' Freedom.
+
+  If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all.  For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+  13. Use with the GNU Affero General Public License.
+
+  Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work.  The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+  14. Revised Versions of this License.
+
+  The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+  Each version is given a distinguishing version number.  If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation.  If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+  If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+  Later license versions may give you additional or different
+permissions.  However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+  15. Disclaimer of Warranty.
+
+  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. Limitation of Liability.
+
+  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+  17. Interpretation of Sections 15 and 16.
+
+  If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+                     END OF TERMS AND CONDITIONS
+
+            How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+  If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+    <program>  Copyright (C) <year>  <name of author>
+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+  You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<http://www.gnu.org/licenses/>.
+
+  The GNU General Public License does not permit incorporating your program
+into proprietary programs.  If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library.  If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.  But first, please read
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/Main.hs b/Main.hs
new file mode 100644
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,237 @@
+{-# LANGUAGE RecursiveDo #-}
+-- | Maintainer: Stephan Friedrichs
+--
+-- The main module to spawn the entire application.
+module Main (
+        main
+) where
+
+import Barracuda.Distributor
+import Barracuda.GUI
+import Barracuda.GUI.Infrastructure
+import Barracuda.GUI.ServerInterface
+import Barracuda.ServerState
+import Barracuda.Utils
+import Codec.Binary.UTF8.String (decodeString)
+import Control.Concurrent
+import Control.Concurrent.STM -- Simon rules :)
+import Control.Monad
+import Data.Maybe
+import Data.Set hiding (null, map)
+import Data.Time
+import Graphics.UI.Gtk hiding (Socket)
+import Network.AdHoc.Generator
+import qualified Data.ByteString as BS
+import qualified Data.List as List
+-- import Network.AdHoc.Message
+-- import Network.AdHoc.UserID
+import qualified Network.GnuTLS as GnuTLS
+import Network.Socket
+import System.Environment
+import System.IO
+import System.Random
+import System.Console.GetOpt
+import System.Exit
+
+-- | The options of a Barracuda instance.
+data Options = Options
+        { userNumber   :: Int
+        , portNumber   :: PortNumber
+        , infras       :: Maybe (Set SockAddr)
+        , bcastAddress :: HostAddress
+        , showHelp     :: Bool
+        , beVerbose    :: Bool
+        , debug        :: Bool
+        } deriving (Show, Eq, Ord)
+
+-- | A type with one constructor for each option of Barracuda.
+data Option
+        = OptUserNumber Int
+        | OptPortNumber PortNumber
+        | OptInfrastructure SockAddr
+        | OptBCast HostAddress
+        | OptVerbose
+        | OptHelp
+        | OptDebug
+        deriving (Show, Eq, Ord)
+
+-- | The default settings.
+defaultOptions :: Options
+defaultOptions = Options
+        { userNumber = 1
+        , portNumber = fromIntegral (8888::Int)
+        , bcastAddress = maxBound -- 255.255.255.255
+        , infras     = Nothing
+        , showHelp   = False
+        , beVerbose  = False
+        , debug      = False
+        }
+
+-- | Initiates a new Barracuda server including gui(s) and an (optional) infrafilter.
+--   The network connections are set up, all the necessary threads are spawned and
+--   the Gtks 'usafeInitGUIForThreadedRTS'- and 'mainGUI' functions are called. For
+--   further description, run @Barracuda --help@ ;)
+main :: IO ()
+main = withSocketsDo $ GnuTLS.withGnuTLS $  do
+        progname <- getProgName
+        args <- getArgs
+        case processArgs args of
+                Left err -> putStrLn err >> putStrLn (usage progname) >>  exitWith (ExitFailure (-1))
+                Right (opts, cert) -> if showHelp opts
+                        then putStrLn (usage progname)
+                        else runBarracuda opts cert
+
+-- | Actually spawns the Barracuda server, taking evaluated 'Options'.
+runBarracuda :: Options -> String -> IO ()
+runBarracuda opts certPath = do
+        -- certificate
+        str_cert <- BS.readFile certPath
+        let Right cert = GnuTLS.importCertificate str_cert GnuTLS.X509FmtPem
+        -- socket
+        sock <- socket AF_INET Datagram 0
+        bindSocket sock (SockAddrInet (portNumber opts) iNADDR_ANY)
+        setSocketOption sock Broadcast 1
+        setSocketOption sock DontRoute 0
+        --setSocketOption sock TimeToLive 1
+        -- DistributorChan, set infrastructural data immediately
+        chan <- newChan
+        getCurrentTime >>= \now -> writeChan chan (now, InfraMsg (infras opts))
+        -- fork timer, socket and guis
+        forkIO $ mainPort sock chan
+        forkIO $ timer chan
+        killGui <- forkGUIs chan (debug opts) (infras opts) (userNumber opts)
+        -- finally run a ServerMonad with the DistributorChans contents
+        msgs <- getChanContents chan
+        runServerMonad
+                (\ids addr msg -> let (xml, nids) = generateMessage ids msg in do
+                        if length xml < 65536
+                                then do
+--                                      putStrLn $ "-----------outgoing-----------\n" ++ xml ++ "\n------------------------------"
+                                        sendTo sock xml addr
+                                        return nids
+                                else return ids)
+                (beVerbose opts) (bcastAddress opts) cert (portNumber opts)
+                (map (\(time, msg) -> (time, processMessage msg)) msgs)
+        killGui
+
+-- | A timer that is to be started as thread. It pings the 'DistributorChan' in a
+--   random interval between 1.5 and 2.5 seconds (i.e. the HELLO interval).
+timer :: DistributorChan -> IO ()
+timer chan = do
+        delay <- randomRIO (1500000, 2500000)
+        threadDelay delay
+        time <- getCurrentTime
+        writeChan chan (time, TimeMsg)
+        timer chan
+
+-- | Listens at the given 'Socket' and filters everything received from the
+--   own server.
+mainPort :: Socket         -- ^ An initialized 'Socket' for UDP communication.
+        -> DistributorChan -- ^ Will receive all incomming messages.
+        -> IO ()
+mainPort sock chan = do
+        (str_msg, _, from) <- recvFrom sock 65535
+        let str_msg_enc = maybe str_msg id $ Just $ decodeString str_msg
+--      putStrLn $ "-----------incoming-----------\n" ++ str_msg ++ "\n------------------------------"
+        now <- getCurrentTime
+        writeChan chan (now, ProtMsg from str_msg_enc)
+        mainPort sock chan
+
+-- | Initiates GUIs and an optional InfraGUI.
+forkGUIs :: DistributorChan     -- ^ Will receive incomming GUI or InfraGUI messages.
+        -> Bool                 -- ^ True if and only if an InfraGUI shall pop up.
+        -> Maybe (Set SockAddr) -- ^ Initial configuration for the InfraGUI (see there).
+        -> Int                  -- ^ How many GUIs to spawn. Zero is OK, negatives are treated alike.
+        -> IO (IO ())
+forkGUIs chan infragui infradata n = do
+        forkOS $ do
+                unsafeInitGUIForThreadedRTS
+                if infragui
+                        then spawnInfra (\infra -> do
+                                time <- getCurrentTime
+                                writeChan chan (time, InfraMsg infra)
+                                ) infradata
+                        else return ()
+                replicateM_ n $ newGUI chan guiNew
+                mainGUI
+        return (postGUIAsync mainQuit)
+
+-- | Spawns an infrastructure gui.
+spawnInfra :: InfraGUI
+spawnInfra sends _ = do -- TODO: do not ignore initial configuration
+        win <- windowNew
+        inf <- infrastructureWidgetNew
+        win `containerAdd` (infrastructureWidgetGet inf)
+        inf `onUpdate` (\lst -> sends (fmap fromList lst))
+        widgetShowAll win
+
+-- | Spawns a new 'GUI'.
+newGUI :: DistributorChan -- ^ Will receive messages from the gui.
+        -> GUI            -- ^ Function used to spawn the gui.
+        -> IO ()
+newGUI chan spawnGUI = mdo
+        (registered, userRef) <- atomically $ do
+                r <- newTVar False
+                u <- newTVar Nothing
+                return (r, u)
+        respondFunction <- spawnGUI (\message -> do
+                time <- getCurrentTime
+                case message of
+                        SetUser uid cert pk -> do
+                                atomically $ writeTVar userRef $ Just (uid, cert, pk)
+                                writeChan chan (time,NewGUI uid cert pk respondFunction)
+                        _                   -> do
+                                (reg, info) <- atomically $ do
+                                        r <- readTVar registered
+                                        i <- readTVar userRef
+                                        return (r, i)
+                                case info of
+                                        Nothing          -> return ()
+                                        Just (uid, cert, pk) -> do
+                                                if not reg
+                                                        then do
+                                                                writeChan chan (time, NewGUI uid cert pk respondFunction)
+                                                                atomically $ writeTVar registered True
+                                                        else return ()
+                                                writeChan chan (time, (GUIMsg uid message))
+                )
+        return ()
+
+-- | Parses the command-line arguments. The IO monad fails to indicate invalid
+--   arguments. If the IO monad returns 'Nothing', the help option has been
+--   supplied. Otherwise 'Just' 'Options' is returned (in the IO monad).
+processArgs :: [String] -> Either String (Options, String)
+processArgs args = let (opts, nargs, errs) = getOpt Permute options args
+        in if null errs
+                then (case nargs of
+                        [cert] -> Right (foldl foldOptions defaultOptions opts, cert)
+                        []     -> Left "no certificate given"
+                        _      -> Left "too many certificates given")
+                else Left (unlines errs)
+
+-- | Applies one 'Option' to a an 'Options' bundle.
+foldOptions :: Options -> Option -> Options
+foldOptions opts (OptUserNumber num) = opts {userNumber = num}
+foldOptions opts (OptPortNumber num) = opts {portNumber = num}
+foldOptions opts (OptInfrastructure addr) = opts {infras = Just $ maybe (singleton addr) (insert addr) (infras opts)}
+foldOptions opts (OptBCast addr) = opts {bcastAddress = addr}
+foldOptions opts OptHelp = opts {showHelp = True}
+foldOptions opts OptVerbose = opts {beVerbose = True}
+foldOptions opts OptDebug = opts {debug = True}
+
+-- | All 'Option's for Barracuda
+options :: [OptDescr Option]
+options =
+        [ Option ['b'] ["broadcast"] (ReqArg ((OptBCast) . readHost') "<ip>") "use <ip> as the broadcast address (default is 255.255.255.255)"
+        , Option ['p'] ["port"] (ReqArg ((OptPortNumber). fromIntegral . read) "<n>") "use specified network port <n> (default is 8888)"
+        , Option ['u'] ["users"] (ReqArg ((OptUserNumber) . read) "<n>") "spawn <n> user inerfaces (default is 1)"
+        , Option ['d'] ["debug"] (NoArg OptDebug) "activate the debugging- (infrastructure-) mode (default is off)"
+        , Option ['i'] ["infrastructure"] (ReqArg ((OptInfrastructure) . (readSockAddr' 8888)) "<addr:[p]>") "add address and port to infrastructure filter and activate it, but do not spawn the infrastucture gui (see -d)"
+        , Option ['v'] ["verbose"] (NoArg OptVerbose) "verbose (default is off)"
+        , Option ['h'] ["help"] (NoArg OptHelp) "displays this text"
+        ]
+
+-- | The usage message displayed, when the --help option is supplied.
+usage :: String   -- ^ The name of the called binary.
+        -> String
+usage name = usageInfo ("Usage:\n" ++ name ++ " [-b <n>] [-p <n>] [-u <n>] [-d] [-i <addr:[p]>] [-v] [-h] certificate") options
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,5 @@
+module Main where
+
+import Distribution.Simple
+
+main = defaultMain
diff --git a/Tests.hs b/Tests.hs
new file mode 100644
--- /dev/null
+++ b/Tests.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE ExistentialQuantification #-}
+module Main where
+
+import Network.GnuTLS (withGnuTLS)
+import System.IO
+import Test.HUnit (runTestTT, Test (TestList))
+import Test.QuickCheck (quickCheck)
+
+import Tests.QuickCheck.Encryption
+import Tests.QuickCheck.Parser
+import Tests.QuickCheck.X509
+import Tests.HUnit.ChannelList
+import Tests.HUnit.PendingAck
+import Tests.HUnit.RoutingTable
+
+main = withGnuTLS $ do
+	hSetBuffering stdout NoBuffering
+	hSetBuffering stderr NoBuffering
+	putStrLn "Running QuickCheck tests:"
+	quickCheck testByteStringEncrypt
+	quickCheck testGeneratorParserId
+	quickCheck rsaParametersMatch
+	quickCheck rsaVerify
+	quickCheck rsaEncrypt
+	putStrLn "Running HUnit tests:"
+	runTestTT $ TestList
+		[channelList1
+		,channelList2
+		,routingTableLookup
+		,routingTableDelete
+		,routingTableUsersMergeNeighbors
+		,pendingAck
+		]
diff --git a/Tests/Data.hs b/Tests/Data.hs
new file mode 100644
--- /dev/null
+++ b/Tests/Data.hs
@@ -0,0 +1,101 @@
+module Tests.Data where
+
+import Data.ByteString as BS hiding (map, putStrLn)
+import Data.Time
+import System.FilePath
+import Network.AdHoc.Channel
+import Network.AdHoc.Signature
+import Network.AdHoc.Message
+import Network.AdHoc.UserID
+import Network.Socket
+import Network.GnuTLS
+import System.IO.Unsafe
+
+-- Declare all testdata here
+
+-- User ids:
+
+user_eq, user_wechner, user_igel, user_spuall :: UserID
+user_eq      = UserID "eq"      "alan"
+user_wechner = UserID "wechner" "mroot"
+user_igel    = UserID "igel"    "garten"
+user_spuall  = UserID "spuall"  "spuall" -- XXX: Just a guess :)
+
+-- ChannelIDs
+
+channel_sep07, channel_barracuda, channel_csstuds :: ChannelID
+channel_sep07     = ChannelID "sep07"     "sse.cs.tu-bs.de" -- :P
+channel_barracuda = ChannelID "barracuda" "up.in.your.arse"
+channel_csstuds   = ChannelID "csstuds"   "freenode.org"
+
+-- ChannelNames
+
+cname_sep07, cname_barracuda, cname_csstuds :: ChannelName
+cname_sep07     = mkChannelName "SEP 07 Channel"
+cname_barracuda = mkChannelName "Barracuda!"
+cname_csstuds   = mkChannelName "CS-Studs"
+
+-- Times
+
+date_jfk,date_malcomX,date_mlk :: UTCTime
+date_jfk     = UTCTime (fromGregorian 1963 11 22) (12*3600+30*60)
+date_malcomX = UTCTime (fromGregorian 1965  2 21) 0
+date_mlk     = UTCTime (fromGregorian 1968  4  4) (18*3600+ 1*60)
+
+-- Addresses
+
+addr_cia, addr_fsf, addr_penisland :: HostAddress
+addr_cia       = unsafePerformIO $ inet_addr "198.81.129.100"
+addr_fsf       = unsafePerformIO $ inet_addr "199.232.41.5"
+addr_penisland = unsafePerformIO $ inet_addr "38.113.185.223"
+
+-- Socket Adresses
+
+saddr_cia, saddr_fsf, saddr_penisland :: SockAddr
+saddr_cia       = SockAddrInet 8888 addr_cia
+saddr_fsf       = SockAddrInet 8888 addr_fsf
+saddr_penisland = SockAddrInet 7777 addr_penisland
+
+-- Messages
+
+routed_innocent, routed_nottl, routed_nack :: Routed TargetContent ExternalSignature
+routed_innocent = Routed 14 user_wechner "29"
+	(Message [user_igel,user_spuall] cname_sep07 channel_sep07
+		(UnencryptedMessage "what was the price on his head?" [])
+		date_malcomX
+		0)
+	Nothing
+routed_nottl    = Routed 0 user_spuall "1788" (GetCertificate user_eq) Nothing
+routed_nack     = Routed 5 user_igel   "80"
+	(Nack (Routed 0 user_wechner "12" (Certificate [user_eq] user_spuall (pack [1,2,3])) Nothing))
+	Nothing
+
+-- Certificates
+
+loadCert :: String -> IO Certificate
+loadCert file = do
+	str <- BS.readFile $ ".." </> "tests" </> "certificates" </> file
+	case importCertificate str X509FmtPem of
+		Right cert -> return cert
+		Left err   -> let msg = "Failed to load certificate" ++ file ++ ": " ++ show err
+			in putStrLn msg >> fail msg
+
+loadKey :: String -> IO PrivateKey
+loadKey file = do
+	str <- BS.readFile $ ".." </> "tests" </> "certificates" </> file
+	case importPrivateKey str X509FmtPem of
+		Right key -> return key
+		Left err  -> let msg = "Failed to load private key" ++ file ++ ": " ++ show err
+			in putStrLn msg >> fail msg
+
+dummyCerts :: IO [Certificate]
+dummyCerts = mapM loadCert (map (\n -> "Dummy"++show n++"-cert.pem") [1..10])
+
+unsafeDummyCerts :: [Certificate]
+unsafeDummyCerts = unsafePerformIO dummyCerts
+
+dummyKeys :: IO [PrivateKey]
+dummyKeys = mapM loadKey (map (\n -> "Dummy"++show n++"-key.pem") [1..10])
+
+unsafeDummyKeys :: [PrivateKey]
+unsafeDummyKeys = unsafePerformIO dummyKeys
diff --git a/Tests/HUnit/ChannelList.hs b/Tests/HUnit/ChannelList.hs
new file mode 100644
--- /dev/null
+++ b/Tests/HUnit/ChannelList.hs
@@ -0,0 +1,46 @@
+module Tests.HUnit.ChannelList where
+
+import Data.Monoid
+import Data.List (sort)
+import Data.Set as Set
+import Data.Time
+import Test.HUnit
+import Tests.Data
+import Network.AdHoc.Channel
+import Network.AdHoc.UserID
+import Barracuda.ChannelList
+
+channelList1 = TestCase $ do
+	let now = date_mlk
+	let cl  =  update now cname_sep07 channel_sep07 "description" True [user_eq]
+		 $ update now cname_sep07 channel_csstuds "description" False [user_eq] (mempty :: ChannelMap)
+	let cl2 = join user_wechner cname_sep07 channel_sep07 cl
+	assertEqual "join and leave on public channel"
+		cl
+		(leave user_igel cname_sep07 channel_sep07 $ join user_igel cname_sep07 channel_sep07 cl)
+	assertEqual "join and leave on private channel"
+		cl
+		(leave user_igel cname_sep07 channel_csstuds $ join user_igel cname_sep07 channel_csstuds cl)
+	assertEqual "complete users set"
+		(Set.singleton user_eq)
+		(usersAll cl)
+	assertEqual "partial users set from public channel"
+		(Set.singleton user_eq)
+		(usersChannel cname_sep07 channel_csstuds cl)
+	assertEqual "partial users set from private channel"
+		(Set.singleton user_eq)
+		(usersChannel cname_sep07 channel_sep07 cl)
+
+channelList2 = TestCase $ do
+	let now   = date_jfk
+	let later = 1 `addUTCTime` now
+	let cl    = update now cname_csstuds   channel_csstuds   "d1" True [user_spuall]
+		  $ update now cname_barracuda channel_barracuda "d2" False [user_igel]
+		  $ mempty :: ChannelMap
+	assertEqual "channel list"
+		[(cname_barracuda, channel_barracuda, "d2", False), (cname_csstuds, channel_csstuds, "d1", True)]
+		(sort $ channels cl)
+	assertEqual "announce purge"
+		(update later cname_barracuda channel_barracuda "d2" False [user_igel] mempty
+			,[(cname_barracuda, channel_barracuda, "d2", Set.singleton user_igel, False)])
+		(announcePurge (Set.singleton user_igel) later later cl)
diff --git a/Tests/HUnit/PendingAck.hs b/Tests/HUnit/PendingAck.hs
new file mode 100644
--- /dev/null
+++ b/Tests/HUnit/PendingAck.hs
@@ -0,0 +1,29 @@
+module Tests.HUnit.PendingAck where
+
+import qualified Data.Set as Set
+import Data.Time
+import Barracuda.PendingAck
+
+import Tests.Data
+import Test.HUnit
+
+pendingAck = TestCase $ do
+	let now     = date_malcomX
+	let later9  = addUTCTime  9 now
+	let later10 = addUTCTime 10 now
+	let later11 = addUTCTime 11 now
+	let pa1     = insert later10 routed_nack saddr_cia
+	            $ insert later9  routed_nottl saddr_penisland -- This message gets removed, because it has no more time to live
+		    $ insert now routed_innocent saddr_cia 
+		    $ empty
+	assertEqual "Purge two messages"
+		[(routed_nottl,later9,Set.empty),(routed_innocent,now,Set.empty)]
+		(snd $ purgeNoAck later11 3 pa1)
+	assertEqual "Ack one message and a few invalids"
+		( insert later10 routed_nack  saddr_cia
+		$ insert later9  routed_nottl saddr_penisland 
+		$ empty)
+		( ack user_igel    "1788" saddr_fsf	-- Should be ignored, wrong host
+		$ ack user_wechner "29"   saddr_cia
+		$ ack user_spuall  "278"  saddr_cia		-- Should be ignored, wrong message-id
+		$ pa1)
diff --git a/Tests/HUnit/RoutingTable.hs b/Tests/HUnit/RoutingTable.hs
new file mode 100644
--- /dev/null
+++ b/Tests/HUnit/RoutingTable.hs
@@ -0,0 +1,47 @@
+module Tests.HUnit.RoutingTable where
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.Time (getCurrentTime)
+import Barracuda.RoutingTable
+import Network.AdHoc.UserID
+import Network.AdHoc.Routing
+import Network.Socket
+import Tests.Data
+import Test.HUnit
+
+routingTableLookup = TestCase $ do
+	let now = date_malcomX
+	let rt = hello now saddr_cia [user_wechner] (empty :: SimpleRT)
+	assertEqual "routeSingle"
+		(Just saddr_cia)
+		(routeSingle user_wechner rt)
+	assertEqual "routeSingle with ignores"
+		Nothing
+		(routeSingle user_wechner (rt, Set.singleton saddr_cia))
+
+routingTableDelete = TestCase $ do
+	let now = date_jfk
+	let rt  = routing now saddr_penisland [(user_eq, 2), (user_spuall, 1)] $ routing now saddr_fsf [(user_eq, 1), (user_spuall, 2)] $ (empty :: SimpleRT)
+	assertEqual "deletion of an optimal host"
+		(Just saddr_fsf)
+		(routeSingle user_spuall $ delete saddr_penisland rt)
+	assertEqual "deletion of a suboptimal host"
+		(Just saddr_penisland)
+		(routeSingle user_eq $ delete saddr_fsf rt)
+
+routingTableUsersMergeNeighbors = TestCase $ do
+	let now = date_mlk
+	let rt =  routing now saddr_cia [(user_eq, 1)]
+		$ routing now saddr_fsf [(user_wechner, 1)]
+		$ routing now saddr_penisland [(user_igel, 1)]
+		$ (empty :: SimpleRT)
+	assertEqual "complete userlist"
+		(Set.fromList [user_eq, user_wechner, user_igel])
+		(userList rt)
+	assertEqual "merge routes for"
+		(Map.fromList [(user_eq, 2), (user_wechner, 2)])
+		(mergeRoutesFor saddr_penisland Set.empty rt)
+	assertEqual "neighbors"
+		(Set.fromList [saddr_cia, saddr_fsf, saddr_penisland])
+		(neighbors rt)
diff --git a/Tests/QuickCheck/Encryption.hs b/Tests/QuickCheck/Encryption.hs
new file mode 100644
--- /dev/null
+++ b/Tests/QuickCheck/Encryption.hs
@@ -0,0 +1,31 @@
+module Tests.QuickCheck.Encryption (testByteStringEncrypt) where
+
+import Control.Monad (replicateM)
+import Data.ByteString
+import Data.Word
+import Network.AdHoc.Encryption
+import Test.QuickCheck
+
+genWord8 :: Gen Word8
+genWord8 = fmap fromIntegral (choose (0,255)::Gen Integer)
+
+instance Arbitrary ByteString where
+	arbitrary = sized $ \sz -> fmap pack $ replicateM (sz*100) genWord8
+	coarbitrary _ = id
+
+genDESKey :: Gen Word64
+genDESKey = do
+	r <- rand
+	let (key,_) = generateDESKey r
+	return key
+
+genIV :: Gen Word64
+genIV = fmap fromIntegral (choose (0,2^64-1)::Gen Integer)
+
+encryptDecrypt :: (Arbitrary a,Encryptable a,Eq a) => a -> Property
+encryptDecrypt obj = forAll genDESKey $ \key ->
+	forAll genIV $ \iv -> 
+	decrypt key (encrypt key iv obj) == Just obj
+
+testByteStringEncrypt :: ByteString -> Property
+testByteStringEncrypt = encryptDecrypt
diff --git a/Tests/QuickCheck/Parser.hs b/Tests/QuickCheck/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Tests/QuickCheck/Parser.hs
@@ -0,0 +1,244 @@
+module Tests.QuickCheck.Parser
+	(testGeneratorParserId) where
+
+import Control.Monad
+import Test.QuickCheck hiding (generate)
+
+import Network.AdHoc.ParserStrict
+import Network.AdHoc.Encryption
+import Network.AdHoc.Generator (generateMessage)
+import Network.AdHoc.Message
+import Network.AdHoc.UserID
+import Network.AdHoc.Channel
+import Network.AdHoc.Signature
+
+import Text.XML.HaXml.Pretty(document)
+import Text.XML.HaXml.Parse(xmlParse)
+
+import Data.ByteString (pack)
+import Data.Word
+import System.Random
+import Data.Time.Clock
+import Data.Time.Calendar
+
+genAscii :: Gen Char
+genAscii = elements (['a'..'z']++['A'..'Z'])
+
+genAsciiString :: Int -> Gen String
+genAsciiString min = sized (\len -> replicateM (len+min) genAscii)
+
+genUser :: Gen UserID
+genUser = do
+	id <- genAsciiString 1
+	host <- genAsciiString 1
+	return $ UserID id host
+
+genChannelID :: Gen ChannelID
+genChannelID = do
+	cvalue <- genAsciiString 1
+	chost <- genAsciiString 1
+	return $ ChannelID cvalue chost
+
+genList :: Int -> Gen a -> Gen [a]
+genList min gen = sized $ \len -> replicateM (min+len) gen
+
+genMaybe :: Gen a -> Gen (Maybe a)
+genMaybe gen = oneof [return Nothing,gen>>=return.Just]
+
+genWord8 :: Gen Word8
+genWord8 = choose (0,255::Int) >>= return.fromIntegral
+
+genWord64 :: Gen Word64
+genWord64 = choose (0,18446744073709551615::Integer) >>= return.fromIntegral
+
+msgGen :: Gen InternalMessage
+msgGen = frequency
+	[(1,genHello)
+	,(1,genAck)
+	,(1,genRouting)
+	,(6,genTarget)
+	,(4,genFlood)
+	,(1,genObscure)]
+
+genHello :: Gen InternalMessage
+genHello = do
+	users <- genList 1 genUser
+	vers <- choose (1,100)
+	greet <- genMaybe (genAsciiString 0)
+	return $ Hello users vers greet
+
+genAck :: Gen InternalMessage
+genAck = do
+	sender <- genUser
+	msgid <- genAsciiString 1
+	return $ Ack sender msgid
+
+genRouting :: Gen InternalMessage
+genRouting = do
+	routes <- sized $ \len -> replicateM len (do
+		user <- genUser
+		hops <- choose (1,30)
+		return (user,hops)
+		)
+	return $ Routing routes
+
+genTarget :: Gen InternalMessage
+genTarget = do
+	rt <- fmap (fmap toInternal) $ genRoutedTarget False
+	return (Target rt)
+
+genRouted :: Gen a -> Gen (Routed a ExternalSignature)
+genRouted inner = do
+	ttl <- choose (0,360::Int) >>= return.fromIntegral
+	user <- genUser
+	msgid <- genAsciiString 1
+	cont <- inner
+	return $ Routed ttl user msgid cont Nothing
+
+genRoutedTarget :: Bool -> Gen (Routed TargetContent ExternalSignature)
+genRoutedTarget in_nack = do
+	let withoutNack =
+		[genGetCertificate
+		,genCertificate
+		,genMessage
+		,genGetKey
+		,genKey]
+	genRouted (if in_nack
+		then oneof withoutNack
+		else oneof $ [genNack]++withoutNack)
+
+genNack :: Gen TargetContent
+genNack = do
+	rt <- genRoutedTarget True
+	return (Nack rt)
+
+genGetCertificate :: Gen TargetContent
+genGetCertificate = genUser >>= return.(GetCertificate)
+
+genCertificate :: Gen TargetContent
+genCertificate = do
+	receivers <- genList 1 genUser
+	for <- genUser
+	dat <- genList 1 genWord8
+	return $ Certificate receivers for (pack dat)
+
+genAttachment :: Gen Attachment
+genAttachment = do
+	filename <- genAsciiString 1
+	appType <- genAsciiString 1
+	content <- fmap pack $ genList 1 genWord8
+	return $ Attachment filename appType content
+
+genTime :: Gen UTCTime
+genTime = do
+	day <- choose (20000,60000)
+	secs <- choose (0,60*60*24)
+	return $ UTCTime
+		{utctDay = ModifiedJulianDay day
+		,utctDayTime = fromInteger secs
+		}
+
+genMessage :: Gen TargetContent
+genMessage = do
+	receivers <- genList 1 genUser
+	cname <- genAsciiString 1
+	cid <- genChannelID
+	content <- genMessageContent
+	time <- genTime
+	delay <- choose (0,360::Int) >>= return.fromIntegral
+	return $ Message receivers (mkChannelName cname) cid content time delay
+
+genMessageContent :: Gen MessageContent
+genMessageContent = do
+	txt <- genAsciiString 1
+	key <- genMaybe genWord64
+	attachments <- genList 0 genAttachment
+	case key of
+		Just rkey -> do
+			iv <- genWord64
+			encattach <- mapM (\attach -> do
+				aiv <- genWord64
+				return $ encryptAttachment rkey aiv attach
+				) attachments
+			return $ EncryptedMessage (encrypt rkey iv txt) encattach
+		Nothing -> return $ UnencryptedMessage txt attachments
+genGetKey :: Gen TargetContent
+genGetKey = do
+	receiver <- genUser
+	cname <- genAsciiString 1
+	cid <- genChannelID
+	return $ GetKey receiver (mkChannelName cname) cid
+
+genCipher :: Gen CipherType
+genCipher = oneof [return CipherDES_CBC
+		  ,return CipherNone
+		  ,genAsciiString 1 >>= return.CipherUnknown]
+
+genKey :: Gen TargetContent
+genKey = do
+	receiver <- genUser
+	cname <- genAsciiString 1
+	cid <- genChannelID
+	cipher <- genCipher
+	key <- fmap RSAEncrypted $ fmap pack $ genList 1 genWord8
+	return $ Key receiver (mkChannelName cname) cid cipher key
+
+genFlood :: Gen InternalMessage
+genFlood = do
+	rt <- fmap (fmap toInternal) $ genRouted (oneof
+		[genChannel
+		,genJoinLeave True
+		,genJoinLeave False
+		,genAnonymous
+		])
+	return $ Flood rt
+
+genChannel :: Gen FloodContent
+genChannel = do
+	cname <- genAsciiString 1
+	cid <- genChannelID
+	title <- genAsciiString 1
+	users <- genList 1 genUser
+	priv <- arbitrary
+	return $ Channel (mkChannelName cname) cid title users priv
+
+genJoinLeave :: Bool -> Gen FloodContent
+genJoinLeave join = do
+	cname <- genAsciiString 1
+	cid <- genChannelID
+	return $ (if join then Join else Leave) (mkChannelName cname) cid
+
+genAnonymous :: Gen FloodContent
+genAnonymous = do
+	text <- genAsciiString 1
+	attach <- genList 0 genAttachment
+	time <- genTime
+	delay <- choose (0,360::Int) >>= return.fromIntegral
+	return $ Anonymous text attach time delay
+
+genObscure :: Gen InternalMessage
+genObscure = fmap Obscure $ fmap (fmap $ const ()) $ genRouted (fmap RSAEncrypted $ fmap pack $ genList 0 genWord8)
+
+classifyMessage :: ProtocolMessage sign -> String
+classifyMessage (Hello _ _ _) = "Hello"
+classifyMessage (Ack _ _) = "Ack"
+classifyMessage (Routing _) = "Routing"
+classifyMessage (Target (Routed _ _ _ tc _)) = case tc of
+	Nack _ -> "Nack"
+	GetCertificate _ -> "GetCertificate"
+	Certificate _ _ _ -> "Certificate"
+	Message _ _ _ _ _ _ -> "Message"
+	GetKey _ _ _ -> "GetKey"
+	Key _ _ _ _ _ -> "Key"
+classifyMessage (Flood (Routed _ _ _ fc _)) = case fc of
+	Channel _ _ _ _ _ -> "Channel"
+	Join _ _ -> "Join"
+	Leave _ _ -> "Leave"
+	Anonymous _ _ _ _ -> "Anonymous"
+classifyMessage (Obscure _) = "Obscure"
+
+genParseId parser = forAll msgGen (\msg -> classify True (classifyMessage msg) $
+	(parser (xmlParse "inp" (fst (generateMessage (map show [0..]) msg))))
+	== Right (fmap (const Nothing) msg))
+
+testGeneratorParserId = genParseId parseMessageNoValidate
diff --git a/Tests/QuickCheck/X509.hs b/Tests/QuickCheck/X509.hs
new file mode 100644
--- /dev/null
+++ b/Tests/QuickCheck/X509.hs
@@ -0,0 +1,66 @@
+module Tests.QuickCheck.X509(rsaParametersMatch,rsaVerify,rsaEncrypt) where
+
+import qualified Codec.Encryption.PKCS1 as PKCS1
+import Data.ByteString as BS hiding (map,zip)
+import Test.QuickCheck
+import Network.GnuTLS
+import Tests.Data
+import System.Random
+
+instance Arbitrary Certificate where
+	arbitrary = elements unsafeDummyCerts
+	coarbitrary _ = id
+
+instance Arbitrary PrivateKey where
+	arbitrary = elements unsafeDummyKeys
+	coarbitrary _ = id
+
+instance Arbitrary DigestAlgorithm where
+	arbitrary = elements [DigMd5,DigSha1,DigRmd160,DigMd2]
+	coarbitrary _ = id
+
+newtype KeyPair = KeyPair (PrivateKey,Certificate) deriving Show
+
+instance Arbitrary KeyPair where
+	arbitrary = elements (map KeyPair $ zip unsafeDummyKeys unsafeDummyCerts)
+	coarbitrary _ = id
+
+classifyPair :: Certificate -> PrivateKey -> Bool -> Bool -> Property
+classifyPair cert key valY valN = let
+	certId = certificateGetKeyId cert
+	keyId  = privateKeyGetKeyId  key
+	in classify (keyId == certId) "matching pairs"
+		$ classify (keyId /= certId) "non-matching pairs"
+		$ if keyId == certId then valY else valN
+
+rsaParametersMatch :: Certificate -> PrivateKey -> Property
+rsaParametersMatch cert key = let
+	certPar = certificateRSAParameters cert
+	keyPar  = do
+		(n,e,d,p,q,u) <- privateKeyRSAParameters key
+		return (n,e)
+	in classifyPair cert key (certPar == keyPar) (certPar /= keyPar)
+
+rsaVerify :: Certificate -> PrivateKey -> ByteString -> DigestAlgorithm -> Property
+rsaVerify cert key str dig = let
+	res = do
+		sig <- signData key dig str
+		verifySignature cert str sig
+	in classifyPair cert key (res==Right True) (res==Right False)
+
+instance Arbitrary StdGen where
+	arbitrary = rand
+	coarbitrary _ = id
+
+rsaEncrypt :: StdGen -> Certificate -> PrivateKey -> ByteString -> Property
+rsaEncrypt gen cert key str = let
+	res = do
+		(n,e) <- certificateRSAParameters cert
+		(n',e',d,p,q,u) <- privateKeyRSAParameters key
+		let pkey = PKCS1.PublicKey (PKCS1.os2ip n) (PKCS1.os2ip e)
+		let skey = PKCS1.PrivateKey $ Right $ PKCS1.PrivateKeyComplex
+			(PKCS1.os2ip n') (PKCS1.os2ip d) (PKCS1.os2ip p) (PKCS1.os2ip q) (PKCS1.os2ip u)
+		let enc = PKCS1.encrypt (BS.length n) pkey gen str
+		let dec = PKCS1.decrypt (BS.length n') skey enc
+		return dec
+	in (not $ BS.null str) ==> classifyPair cert key (res == Right (Just str)) (res == (Right Nothing))
