packages feed

HNM 0.1.1 → 0.1.2

raw patch · 6 files changed

+162/−101 lines, 6 files

Files

HNM.cabal view
@@ -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
HNM/WLAN.hs view
@@ -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)
LICENSE view
@@ -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.
Main.hs view
@@ -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."
README view
@@ -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.
settings.conf view
@@ -1,3 +1,5 @@ [-Encrypted "o2DSL"   (WEP    ) "gLcfefcJcYnSU"+Wireless "stardust"    Nothing                         ,+Wireless "o2DSL"       (Just (WEP,    "gLcfefcJcYnSU")),+Wireless "Hello-Teddy" (Just (WPA Two,"bloodymonday" )) ]