diff options
-rw-r--r-- | Presence/LocalPeerCred.hs | 6 | ||||
-rw-r--r-- | Presence/main.hs | 41 |
2 files changed, 40 insertions, 7 deletions
diff --git a/Presence/LocalPeerCred.hs b/Presence/LocalPeerCred.hs index c58fe288..990975ee 100644 --- a/Presence/LocalPeerCred.hs +++ b/Presence/LocalPeerCred.hs | |||
@@ -49,9 +49,11 @@ getLocalPeerCred sock = do | |||
49 | addr <- getPeerName sock | 49 | addr <- getPeerName sock |
50 | muid <- getLocalPeerCred' addr | 50 | muid <- getLocalPeerCred' addr |
51 | case muid of | 51 | case muid of |
52 | Just uid -> return uid | 52 | Just uid -> return (Just uid) |
53 | Nothing -> return undefined -- trace "proc failed." $ fmap (CUid . fromIntegral . sndOf3) (getPeerCred sock) | 53 | Nothing -> trace "proc failed." $ fmap (validate . CUid . fromIntegral . sndOf3) (getPeerCred sock) |
54 | where sndOf3 (pid,uid,gid) = uid | 54 | where sndOf3 (pid,uid,gid) = uid |
55 | where | ||
56 | validate uid = Just uid -- TODO | ||
55 | 57 | ||
56 | from16 :: Word16 -> Int | 58 | from16 :: Word16 -> Int |
57 | from16 = fromEnum | 59 | from16 = fromEnum |
diff --git a/Presence/main.hs b/Presence/main.hs index 7a5939ff..d679fdba 100644 --- a/Presence/main.hs +++ b/Presence/main.hs | |||
@@ -18,6 +18,11 @@ import XMPPServer | |||
18 | import Data.HList | 18 | import Data.HList |
19 | import Network.Socket (sClose) | 19 | import Network.Socket (sClose) |
20 | import Control.Exception | 20 | import Control.Exception |
21 | import LocalPeerCred | ||
22 | import ByteStringOperators | ||
23 | import qualified Data.ByteString.Lazy.Char8 as L | ||
24 | import System.Posix.User | ||
25 | |||
21 | 26 | ||
22 | jid user host rsrc = user ++ "@" ++ host ++ "/" ++ rsrc | 27 | jid user host rsrc = user ++ "@" ++ host ++ "/" ++ rsrc |
23 | 28 | ||
@@ -37,14 +42,40 @@ utmp_event e = do | |||
37 | forM_ ids putStrLn | 42 | forM_ ids putStrLn |
38 | #endif | 43 | #endif |
39 | 44 | ||
40 | data UnixSession = UnixSession | 45 | data UnixSession = UnixSession { |
46 | unix_uid :: (IORef (Maybe UserID)), | ||
47 | unix_resource :: (IORef (Maybe L.ByteString)) | ||
48 | } | ||
41 | 49 | ||
42 | instance XMPPSession UnixSession where | 50 | instance XMPPSession UnixSession where |
43 | data XMPPClass UnixSession = UnixSessions | 51 | data XMPPClass UnixSession = UnixSessions |
44 | newSession _ sock handle = putStrLn "SESSION: open" >> return UnixSession | 52 | newSession _ sock handle = do |
45 | setResource _ resource = putStrLn "SESSION: resource" | 53 | muid <- getLocalPeerCred sock |
46 | getJID _ = putStrLn "SESSION: jid" >> return "nobody@fake.bad" | 54 | putStrLn $ "SESSION: open " ++ show muid |
47 | closeSession _ = putStrLn "SESSION: close" >> return () | 55 | uid_ref <- newIORef muid |
56 | res_ref <- newIORef Nothing | ||
57 | return $ UnixSession uid_ref res_ref | ||
58 | setResource s resource = do | ||
59 | writeIORef (unix_resource s) (Just resource) | ||
60 | L.putStrLn $ "SESSION: resource " <++> resource | ||
61 | getJID s = do | ||
62 | let host = "localhost" -- TODO | ||
63 | muid <- readIORef (unix_uid s) | ||
64 | user <- maybe (return "nobody") | ||
65 | (\uid -> | ||
66 | handle (\(SomeException _) -> | ||
67 | return . L.append "uid." . L.pack . show $ uid) | ||
68 | $ do | ||
69 | user <- fmap userName $ getUserEntryForID uid | ||
70 | return (L.pack user) | ||
71 | ) | ||
72 | muid | ||
73 | rsc <- readIORef (unix_resource s) | ||
74 | let suf = maybe "" ("/"<++>) rsc | ||
75 | jid = user <++> "@" <++> L.pack host <++> suf | ||
76 | L.putStrLn $ "SESSION: jid " <++> jid | ||
77 | return jid | ||
78 | closeSession _ = putStrLn "SESSION: close" | ||
48 | 79 | ||
49 | on_chvt vtnum = do | 80 | on_chvt vtnum = do |
50 | putStrLn $ "changed vt to "++ show vtnum | 81 | putStrLn $ "changed vt to "++ show vtnum |