diff --git a/HNM.cabal b/HNM.cabal --- a/HNM.cabal +++ b/HNM.cabal @@ -1,5 +1,5 @@ name: HNM -version: 0.1.1 +version: 0.1.2 copyright: (c) 2008 Cetin Sert cabal-version: >= 1.2 description: A quick and dirty applet to help you connect @@ -15,12 +15,12 @@ build-type: Simple -data-files: settings.conf, - Makefile +data-files: settings.conf extra-source-files: AUTHORS, README, - CHANGES + CHANGES, + Makefile Library buildable: True diff --git a/HNM/WLAN.hs b/HNM/WLAN.hs --- a/HNM/WLAN.hs +++ b/HNM/WLAN.hs @@ -1,5 +1,6 @@ {-# OPTIONS -fglasgow-exts #-} +-- | WLAN Commands module HNM.WLAN where import IO @@ -39,12 +40,13 @@ type Cell = String type IP = String type AP = String +type Driver = String getDefaultInterface :: IO Interface getDefaultInterface = return . head =<< getInterfaces getInterfaces :: IO [Interface] -getInterfaces = do +getInterfaces = do cat ← run "cat /proc/net/wireless" return $ filter (/= "") $ map (matching " *(.*[0-9]+):") $ lines cat @@ -54,12 +56,18 @@ getCells :: String → [Cell] getCells block = map unwords $ groupBy (const $ (/=) "Cell") $ words block -data Encryption = None | WEP | WPA Version - deriving (Show, Read, Eq, Ord) -data Version = One | Two - deriving (Show, Read, Eq, Ord) +-- | WLAN encryption values +data Encryption = None -- ^ no encryption + | WEP -- ^ WEP encryption + | WPA Version -- ^ WPA encryption + deriving (Show, Read, Eq, Ord) +-- | WPA version +data Version = One + | Two + deriving (Show, Read, Eq, Ord) + type Quality = Int type Unit = (MAC,Quality) @@ -69,7 +77,7 @@ cencrypt :: Encryption, ccell :: [Unit] } - deriving (Show, Read, Eq, Ord) + deriving (Show, Read, Eq, Ord) meanQuality :: [Quality] → Quality meanQuality = round . mean . (map (fromInteger . toInteger)) @@ -105,14 +113,15 @@ where getEssid = matching "ESSID:\"(.*)\"" getMac = matching "Address: (.{17})" - getQuality = \c → case matching "Quality=(.*)/100" c of { "" → 0; q → read q :: Int} + getQuality = \c → case matching "Quality=(.*)/100" c of { "" → 0; q → read q :: Int } getEncrypt = \c → case matching "Encryption key:(on|off)" c of - "on" → case matching "WPA Version (.)" c of - "1" → WPA One - "2" → WPA Two - _ → WEP - "off" → None + "on" → case matching "(WPA.)" c of + "WPA " → WPA One + "WPA2" → WPA Two + _ → WEP + _ → None +-- | given an interface, returns a list of wireless lans getWLANs :: Interface → IO [WLAN] getWLANs interface = return . {-debug . -}map cellToWLAN =<< scan interface @@ -140,7 +149,7 @@ ap → return . Connected ip =<< getESSID interface matching :: String → String → String -matching = \pattern info → case info =~ pattern of { [[a,b]] → b; _ → "" } +matching = \pattern info → case info =~ pattern of { [[a,b]] → b; [[a,b],[c,d]] → d; _ → "" } debug :: Show a ⇒ a → a debug a = unsafePerformIO (print a >> return a) @@ -166,16 +175,25 @@ wpa_supplicant :: [String] → IO () wpa_supplicant = pcom "wpa_supplicant" -initHardware :: String → Interface → IO () +initHardware :: Driver → Interface → IO () initHardware driver interface = do disconnect interface - modprobe ["-r", driver] - modprobe [driver] - ifconfig [interface, "up"] + deactivate driver interface + activate driver interface threadDelay 2000000 exec $ "iwlist " ++ interface ++ " scan" return () +deactivate :: Driver → Interface → IO () +deactivate driver interface = do + ifconfig [interface, "down"] + modprobe ["-r", driver] + +activate :: Driver → Interface → IO () +activate driver interface = do + modprobe [driver] + ifconfig [interface, "up"] + disconnect :: Interface → IO () disconnect interface = do exec $ "killall dhclient" @@ -184,25 +202,36 @@ connectFree :: Interface → SSID → IO () connectFree interface ssid = do - disconnect interface - ifconfig [interface, "up"] - iwconfig [interface, "essid", ssid] - dhclient [interface] + connect interface (Wireless ssid Nothing) -connectWEP :: Interface → SSID → Key → IO () -connectWEP interface ssid key = do +connect :: Interface → ConnectionSetting → IO () +connect interface (Wireless ssid enc) = do disconnect interface ifconfig [interface, "up"] - iwconfig [interface, "essid", ssid, "key", "s:" ++ key] + case enc of + Nothing → iwconfig [interface, "essid", ssid] + Just (WEP, key) → iwconfig [interface, "essid", ssid, "key", "s:" ++ key] + Just (WPA _, key) → wpaconfig [interface, ssid, key] dhclient [interface] ------ -data ConnectionSetting = Free SSID - | Encrypted SSID Encryption Key - deriving (Show, Read, Eq, Ord) +wpaconfig :: [String] → IO () +wpaconfig [interface, ssid, key] = do + h ← openFile wpa_temp WriteMode + l h $ "network={" + l h $ "" + l h $ " ssid=\"" ++ ssid ++ "\"" + l h $ " key_mgmt=WPA-PSK" + l h $ " psk=\"" ++ key ++ "\"" + l h $ "" + l h $ "}" + hClose h + wpa_supplicant ["-B", "-c"++wpa_temp, "-i"++interface] + threadDelay 2000000 + where + l = hPutStrLn -connect :: Interface → ConnectionSetting → IO () -connect it (Free id ) = connectFree it id -connect it (Encrypted id WEP ky) = connectWEP it id ky -connect _ _ = do - putStrLn "Only non- or WEP-encrypted networks can be connected to." +wpa_temp :: FilePath +wpa_temp = "/tmp/wpatemp.conf" + +data ConnectionSetting = Wireless SSID (Maybe (Encryption,Key)) + deriving (Show, Read, Eq, Ord) diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,22 +1,31 @@ -Copyright (c) 2008 Cetin Sert. All rights reserved. +Copyright (c) 2008, Cetin Sert -Redistribution and use in source and binary forms, with or without modification, -are permitted provided that the following conditions are met: +All rights reserved. - 1. Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: - 2. Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. -THIS SOFTWARE IS PROVIDED BY THE FREEBSD PROJECT ``AS IS'' AND ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT -SHALL THE FREEBSD PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * The names of contributors may not be used to endorse or promote + products derived from this software without specific prior + written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -29,14 +29,16 @@ main :: IO Int main = start =<< getArgs --assu (start =<< getArgs) warn - -warn :: IO Int -warn = do - warnVisual MessageError ButtonsOk appName $ - "You have to be root to run " ++ appName ++ "!" + +errorVisual :: String → IO Int +errorVisual msg = do + warnVisual MessageError ButtonsOk appName msg return 1 +warn :: IO Int +warn = errorVisual $ "You have to be root to run " ++ appName ++ "!" + warnVisual :: MessageType → ButtonsType → String → String → IO ResponseId warnVisual mt bt tt msg = do putStrLn msg @@ -56,8 +58,10 @@ start ["--license"] = do printLicense start [] = do - is@(i:_) ← getInterfaces - withArgs is $ start is + is ← getInterfaces + case is of + [] → errorVisual "No wireless network interfaces." + _ → withArgs is $ start is start [interface] = assu (do putStrLn interface initGUI @@ -194,19 +198,27 @@ onDestroy win mainQuit widgetShowAll win - return win +-- forkIO autorefresh + return win +autorefresh :: IO () +autorefresh = do + refresh + putStrLn "refreshed" + system "sleep 1" + autorefresh + wlanTreeViewNew :: IO TreeView wlanTreeViewNew = do model ← wlanTreeModelNew view ← treeViewNewWithModel model cs@[c1,c2,c3,c4] ← replicateM 4 treeViewColumnNew mapM_ (\(c,t) → treeViewColumnSetTitle c t) $ zip cs - ["essid", "quality", "encryption", "status"] - [r1,r3] ← replicateM 2 cellRendererTextNew - r2 ← cellRendererProgressNew - r4 ← cellRendererToggleNew + ["", "essid", "quality", "encryption"] + [r2,r4] ← replicateM 2 cellRendererTextNew + r3 ← cellRendererProgressNew + r1 ← cellRendererToggleNew mapM_ (\(c,pc) → pc c) $ zip cs ([pack r1, @@ -214,21 +226,19 @@ pack r3, pack r4]) - treeViewColumnSetSizing c2 TreeViewColumnFixed - treeViewColumnSetFixedWidth c2 150 - treeViewColumnSetSizing c4 TreeViewColumnFixed - treeViewColumnSetFixedWidth c4 50 + treeViewColumnSetSizing c3 TreeViewColumnFixed + treeViewColumnSetFixedWidth c3 150 s ← getConnectionStatus =<< interfaceArg - cellLayoutSetAttributes c1 r1 model $ \r → [ cellText := idof r ] - cellLayoutSetAttributes c2 r2 model $ \r → [ cellProgressValue := qual r, + cellLayoutSetAttributes c2 r2 model $ \r → [ cellText := idof r ] + cellLayoutSetAttributes c3 r3 model $ \r → [ cellProgressValue := qual r, cellProgressText := Just "" ] - cellLayoutSetAttributes c3 r3 model $ \r → [ cellText := show (cencrypt r) ] - cellLayoutSetAttributes c4 r4 model $ \r → [ cellToggleActive := conn s r, + cellLayoutSetAttributes c4 r4 model $ \r → [ cellText := show (cencrypt r) ] + cellLayoutSetAttributes c1 r1 model $ \r → [ cellToggleActive := conn s r, cellToggleRadio := True ] - on r4 cellToggled (connect model) + on r1 cellToggled (connect model) mapM_ (treeViewAppendColumn view) cs widgetShowAll view @@ -261,9 +271,7 @@ "No configuration for encrypted network " ++ id ++ " found in: " ++ settingsFile) >> return () where - settingEq id (Encrypted sid _ _) = id == sid - settingEq _ _ = False - + settingEq id (Wireless sid _) = id == sid settingsFile :: FilePath settingsFile = "/etc/hnm.conf" @@ -284,10 +292,12 @@ True → return . Just =<< readFile file False → return Nothing + wlanTreeModelNew :: IO (TreeStore CWLAN) wlanTreeModelNew = do treeStoreNew . (map cwlanToNode) . compact =<< getWLANs =<< interfaceArg + cwlanToNode :: CWLAN → Tree CWLAN cwlanToNode w = Node w s where @@ -297,12 +307,14 @@ ln = length cs c2w w c = Node (CWLAN (fst c) (cencrypt w) [([],snd c)]) [] + disconnectHandler :: Interface → IO () disconnectHandler interface = do disconnect interface ifconfig [interface, "up"] refresh + doif :: Monad m ⇒ Bool → m () → m () doif True act = act doif False _ = return () @@ -353,7 +365,7 @@ appNameShort = "HNM" appVersion :: String -appVersion = "0.1.1" +appVersion = "0.1.2" showAbout :: IO () @@ -388,27 +400,35 @@ putStrLn "" return 0 - license :: String -license = "Copyright (c) 2008 Cetin Sert. All rights reserved.\n\ +license = "Copyright (c) 2008, Cetin Sert\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\ +\All rights reserved.\n\ \\n\ -\ 1. Redistributions of source code must retain the above copyright notice,\n\ -\ this list of conditions and the following disclaimer.\n\ +\Redistribution and use in source and binary forms, with or without\n\ +\modification, are permitted provided that the following conditions are\n\ +\met:\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\ +\ 1. Redistributions of source code must retain the above copyright\n\ +\ notice, this list of conditions and the following disclaimer.\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." +\ 2. Redistributions in binary form must reproduce the above\n\ +\ copyright notice, this list of conditions and the following\n\ +\ disclaimer in the documentation and/or other materials provided\n\ +\ with the distribution.\n\ +\\n\ +\ 3. The names of contributors may not be used to endorse or promote\n\ +\ products derived from this software without specific prior\n\ +\ written permission.\n\ +\\n\ +\THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS\n\ +\\"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT\n\ +\LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR\n\ +\A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT\n\ +\OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\n\ +\SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\n\ +\LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\n\ +\DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\n\ +\THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n\ +\(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\n\ +\OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE." diff --git a/README b/README --- a/README +++ b/README @@ -27,5 +27,6 @@ Wireless Networks - Handles only a single interface at a time. - - No support for WAP and VPN. + - Limited support for WAP: only PSK mode. + - No support for VPN. - No driver detection. diff --git a/settings.conf b/settings.conf --- a/settings.conf +++ b/settings.conf @@ -1,3 +1,5 @@ [ -Encrypted "o2DSL" (WEP ) "gLcfefcJcYnSU" +Wireless "stardust" Nothing , +Wireless "o2DSL" (Just (WEP, "gLcfefcJcYnSU")), +Wireless "Hello-Teddy" (Just (WPA Two,"bloodymonday" )) ]