HNM 0.1 → 0.1.1
raw patch · 4 files changed
+155/−140 lines, 4 filesdep +directory
Dependencies added: directory
Files
+ CHANGES view
@@ -0,0 +1,26 @@+Fri Dec 26 20:58:20 CET 2008 Cetin Sert cetin@sertcom.de+ tagged 0.1.1++Fri Dec 26 20:57:32 CET 2008 Cetin Sert cetin@sertcom.de+ * changed CLI++Thu Dec 25 16:07:36 CET 2008 Cetin Sert cetin@sertcom.de+ tagged pruning: removed Table-based interface++Thu Dec 25 16:05:02 CET 2008 Cetin Sert cetin@sertcom.de+ * bugfix: settings.conf -> /etc/hnm.conf; pruning: removed Table-based interface++Thu Dec 25 14:47:50 CET 2008 Cetin Sert cetin@sertcom.de+ * fixed width for status column++Wed Dec 24 08:04:27 CET 2008 Cetin Sert cetin@sertcom.de+ * added --version and --license options++Wed Dec 24 07:37:24 CET 2008 Cetin Sert cetin@sertcom.de+ * bugfix: GTK+ main loop would not be broken when the HNM window was closed not through the 'Quit' action.++Wed Dec 24 07:29:24 CET 2008 Cetin Sert cetin@sertcom.de+ * bugfix: embedded license into Main.hs resolving run-time bug: non-existing license file++Wed Dec 24 07:11:02 CET 2008 Cetin Sert cetin@sertcom.de+ * added a fix for non-existing settings.conf
HNM.cabal view
@@ -1,5 +1,5 @@ name: HNM-version: 0.1+version: 0.1.1 copyright: (c) 2008 Cetin Sert cabal-version: >= 1.2 description: A quick and dirty applet to help you connect@@ -19,7 +19,8 @@ Makefile extra-source-files: AUTHORS,- README+ README,+ CHANGES Library buildable: True@@ -34,7 +35,8 @@ regex-posix, process, containers,- haskell98+ haskell98,+ directory Executable HNM buildable: True
Main.hs view
@@ -13,6 +13,7 @@ import System.Exit import System.Process import Graphics.UI.Gtk hiding (disconnect)+import System.Directory import System.IO.Unsafe import Text.Regex.Posix import System.Posix.User@@ -27,7 +28,7 @@ --import HNM.Settings main :: IO Int-main = assu (start =<< getArgs) warn+main = start =<< getArgs --assu (start =<< getArgs) warn warn :: IO Int@@ -48,10 +49,16 @@ start :: [String] → IO Int+start ["--version"] = do+ printVersion+start ["-V"] = do+ printVersion+start ["--license"] = do+ printLicense start [] = do is@(i:_) ← getInterfaces withArgs is $ start is-start [interface] = do+start [interface] = assu (do putStrLn interface initGUI windowSetDefaultIconName "gtk-network"@@ -61,29 +68,16 @@ taskbarIcon =: icn statusIconSetVisible icn True mainGUI- return 0-start [interface,driver] = do+ return 0) warn+start [interface,driver] = assu (do putStrLn driver initHardware driver interface- start [interface]+ start [interface]) warn interfaceArg :: IO Interface interfaceArg = return . (\(i:_) → i) =<< getArgs -refresh :: IO ()-refresh = refresh2--refresh1 :: IO ()-refresh1 = do- putStrLn "refresh"- win ← readIORef mainWindow- widgetDestroy win- xxx ← mainWindowNew- mainWindow =: xxx- return ()-- {-# NOINLINE mainWindow #-} mainWindow :: IORef Window mainWindow = unsafePerformIO $ newIORef $ unsafePerformIO mainWindowNew@@ -108,19 +102,16 @@ (=:) :: IORef a → a → IO a r =: v = writeIORef r v >> return v - alternateMainWindowVisibility :: IO () alternateMainWindowVisibility = do vis ← mutateUsing not mainWindowVisibility (if vis then widgetShow else widgetHide) =<< readIORef mainWindow - mutateUsing :: (a → a) → IORef a → IO a mutateUsing f r = (r =:) . f =<< x r where x = readIORef - (⇆) :: a → a → IO a c ⇆ d = do it ← interfaceArg@@ -147,12 +138,12 @@ mkmenu s = do m ← menuNew i ← interfaceArg- mapM_ (mkitem m) [("gtk-refresh", refresh) ,- ("gtk-disconnect", disconnect_ i),- ("---", undefined) ,- ("gtk-about", showAbout) ,- ("---", undefined) ,- ("gtk-quit", mainQuit) ]+ mapM_ (mkitem m) [("gtk-refresh", refresh) ,+ ("gtk-disconnect", disconnectHandler i),+ ("---", undefined) ,+ ("gtk-about", showAbout) ,+ ("---", undefined) ,+ ("gtk-quit", mainQuit) ] return m where mkitem menu ("---",_) = do@@ -164,8 +155,8 @@ return () -refresh2 :: IO ()-refresh2 = do+refresh :: IO ()+refresh = do vbx ← readIORef mainBox vio ← readIORef mainView containerRemove vbx vio@@ -200,7 +191,7 @@ windowSetTitle win appName --- onDestroy win mainQuit+ onDestroy win mainQuit widgetShowAll win return win @@ -222,9 +213,11 @@ pack r2, pack r3, pack r4])-+ treeViewColumnSetSizing c2 TreeViewColumnFixed treeViewColumnSetFixedWidth c2 150+ treeViewColumnSetSizing c4 TreeViewColumnFixed+ treeViewColumnSetFixedWidth c4 50 s ← getConnectionStatus =<< interfaceArg @@ -266,17 +259,31 @@ Just s → connect it s >> refresh _ → (warnVisual MessageError ButtonsOk appName $ "No configuration for encrypted network " ++ id ++- " found in " ++ settingsFile ++ "!") >> return ()+ " found in: " ++ settingsFile) >> return () where settingEq id (Encrypted sid _ _) = id == sid settingEq _ _ = False -settingsFile :: String-settingsFile = "settings.conf" +settingsFile :: FilePath+settingsFile = "/etc/hnm.conf"+ readSettings :: IO [ConnectionSetting]-readSettings = return . read =<< readFile settingsFile+readSettings = do+ mc ← tryReadFile settingsFile+ case mc of+ Just contents → return . read $ contents+ _ → create settingsFile >> return []+ where+ create f = writeFile f "[]" +tryReadFile :: FilePath → IO (Maybe String)+tryReadFile file = do+ exists ← doesFileExist file+ case exists of+ True → return . Just =<< readFile file+ False → return Nothing+ wlanTreeModelNew :: IO (TreeStore CWLAN) wlanTreeModelNew = do treeStoreNew . (map cwlanToNode) . compact =<< getWLANs =<< interfaceArg@@ -290,107 +297,12 @@ ln = length cs c2w w c = Node (CWLAN (fst c) (cencrypt w) [([],snd c)]) [] --wlanTableNew :: IO Table-wlanTableNew = do- it ← interfaceArg- ws ← getWLANs it- ln ← (return . length) ws- tb ← tableNew 5 (ln + 2) False- attach ws ln tb it- where- attach ws ln tb it = do- att 0 =<< markup "<b>essid</b>" =<< label- att 1 =<< markup "<b>quality</b>" =<< label- att 2 =<< markup "<b>encryption</b>" =<< label- att 3 =<< markup "<b>password</b>" =<< label- att 4 =<< markup "<b>action</b>" =<< label- populate tb ws =<< getConnectionStatus it- return tb- where- att = \c w → tableAttach tb w c (c+1) 0 (0+1) exfi [] padd padd---label = labelNew Nothing-markup = \m l → labelSetMarkup l m >> return l-settext = \t l → labelSetText l t >> return l-c f a l = f l a >> return l- --populate :: Table → [WLAN] → ConnectionStatus → IO ()-populate tb [] _ = return ()-populate tb ws cs = adr tb 1 (compact ws)- where- adr tb i [] = return ()- adr tb i (w:ws) = do--- ad0 0 =<< labelNew (Just id)- ad0 0 =<< c labelSetAngle (0 ? 25) =<< settext id =<< label- ad1 1 =<< pbar ql- ad0 2 =<< labelNew (Just (show en))- get ← pb- doif (any (en ==) [None, WEP]) (ad4 4 =<< cbt get id)- adr tb (i+1) ws- where- (?) = \a b → case cs of NotConnected → a; Connected _ ci → if (ci == id) then b else a- cnc = case cs of Connected _ _ → True; _ → False- cid = case cs of Connected _ cid → cid; _ → []- bd = ("<b>" ++ ) . ( ++ "</b>")- id = cessid w- en = cencrypt w- us = ccell w- ln = length us- qs = map snd us- ql = mean $ map (fromInteger . toInteger) qs- ad0 = \c w → tableAttach tb w c (c+1) i (i+1) ox oy px py- ad1 = \c w → tableAttach tb w c (c+1) i (i+1) ox oy px py- ad3 = \c w → tableAttach tb w c (c+1) i (i+1) ox oy px py- ad4 = \c w → tableAttach tb w c (c+1) i (i+1) ox oy px py- ox = exfi- oy = []- px = padd- py = padd- pb = do- if any (en ==) [WEP] && (cid /= id)- then do- entry ← entryNew--- entrySetVisibility entry False- ad3 3 entry- return $ Just (entryGetText entry)- else do- return $ Nothing- cbt = \get ssid → do- btn ← buttonNew- buttonSetRelief btn ReliefNone- buttonSetUseStock btn True- buttonSetLabel btn ("gtk-connect" ? "gtk-disconnect")- int ← interfaceArg- onClicked btn $ (connectOBS int ssid en get) ? (disconnect_ int)- return btn--exfi = [Expand,Fill]-padd = 4---disconnect_ :: Interface → IO ()-disconnect_ interface = do+disconnectHandler :: Interface → IO ()+disconnectHandler interface = do disconnect interface ifconfig [interface, "up"] refresh --connectOBS :: Interface → SSID → Encryption → Maybe (IO String) → IO ()-connectOBS interface ssid None Nothing = connectFree interface ssid >> refresh-connectOBS interface ssid WEP (Just getKey) = (connectWEP interface ssid =<< getKey) >> refresh---pbar :: Double → IO ProgressBar-pbar val = do- bar ← progressBarNew- progressBarSetFraction bar (val / 100)--- progressBarSetText bar $ show val- return bar-- doif :: Monad m ⇒ Bool → m () → m () doif True act = act doif False _ = return ()@@ -420,8 +332,8 @@ maybeMenubar ← uiManagerGetWidget ui "/ui/menubar" return $ fromJust maybeMenubar--menuDecl = "<ui>\+ where+ menuDecl = "<ui>\ \ <menubar>\ \ <menu action=\"FMA\">\ \ <menuitem action=\"REFA\" />\@@ -437,14 +349,20 @@ appName :: String appName = "Happy Network Manager" +appNameShort :: String+appNameShort = "HNM" +appVersion :: String+appVersion = "0.1.1"++ showAbout :: IO () showAbout = do dlg ← aboutDialogNew- lcs ← readFile "LICENSE" -- tryReadFile+ lcs ← return license set dlg [- aboutDialogName := "Happy Network Manager",- aboutDialogVersion := "0.1",+ aboutDialogName := appName,+ aboutDialogVersion := appVersion, aboutDialogComments := "A quick and dirty applet to help you connect to wireless networks.", aboutDialogCopyright := "Copyright © 2008 Cetin Sert", aboutDialogWebsite := "http://sert.homedns.org/hs/hnm/",@@ -455,3 +373,42 @@ onResponse dlg (\_ → widgetDestroy dlg) dialogRun dlg return ()+++printVersion :: IO Int+printVersion = do+ putStrLn $ appName ++ " " ++ appVersion+ putStrLn ""+ return 0++printLicense :: IO Int+printLicense = do+ printVersion+ putStrLn license+ putStrLn ""+ return 0+++license :: String+license = "Copyright (c) 2008 Cetin Sert. All rights reserved.\n\+\\n\+\Redistribution and use in source and binary forms, with or without modification,\n\+\are permitted provided that the following conditions are met:\n\+\\n\+\ 1. Redistributions of source code must retain the above copyright notice,\n\+\ this list of conditions and the following disclaimer.\n\+\\n\+\ 2. Redistributions in binary form must reproduce the above copyright notice,\n\+\ this list of conditions and the following disclaimer in the documentation\n\+\ and/or other materials provided with the distribution.\n\+\\n\+\THIS SOFTWARE IS PROVIDED BY THE FREEBSD PROJECT ``AS IS'' AND ANY EXPRESS OR\n\+\IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF\n\+\MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT\n\+\SHALL THE FREEBSD PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,\n\+\INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\n\+\LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR\n\+\PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF\n\+\LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE\n\+\OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF\n\+\ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
README view
@@ -1,1 +1,31 @@ Happy Network Manager+++CONNECTING TO ENCRYPTED WIRELESS LANS++ - Use /etc/hnm.conf to store the network information.+++KNOWN ISSUES++ Graphical User Interface++ - This package only builds with gtk2hs from darcs HEAD**.+ - GUI is not complete:++ - Blocks on connect.+ - No settings window to edit settings.conf.+ - StatusIcon disappears after a few refreshes.+ - Connection progress displayed in terminal, not in GUI.+++ Wired Networks+ + - No support in HNM 0.1.x.+++ Wireless Networks++ - Handles only a single interface at a time.+ - No support for WAP and VPN.+ - No driver detection.