module HNM.WLAN where
import IO
import Data.List
import System.IO
import System.Exit
import System.Process
import System.IO.Unsafe
import Text.Regex.Posix
import System.Posix.User
import System.Environment
import Control.Concurrent
import Control.Monad.State
ignore :: Monad m ⇒ m a → m ()
ignore _ = return ()
assu :: IO a → IO a → IO a
assu a b = do
root ← userIsRoot
case root of
True → a
False → b
userIsRoot :: IO Bool
userIsRoot = return . (0 ==) =<< getRealUserID
run :: String → IO String
run cmd = do
(i,o,e,h) ← runInteractiveCommand cmd
hGetContents o >>= \s → waitForProcess h >> return s
type Key = String
type SSID = String
type MAC = String
type Interface = String
type Cell = String
type IP = String
type AP = String
type Driver = String
getDefaultInterface :: IO Interface
getDefaultInterface = return . head =<< getInterfaces
getInterfaces :: IO [Interface]
getInterfaces = do
cat ← run "cat /proc/net/wireless"
return $ filter (/= "") $ map (matching " *(.*[0-9]+):") $ lines cat
scan :: Interface → IO [Cell]
scan interface = return . drop 1 . getCells =<< run ("iwlist " ++ interface ++ " scan")
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)
type Quality = Int
type Unit = (MAC,Quality)
data CWLAN = CWLAN
{
cessid :: SSID,
cencrypt :: Encryption,
ccell :: [Unit]
}
deriving (Show, Read, Eq, Ord)
meanQuality :: [Quality] → Quality
meanQuality = round . mean . (map (fromInteger . toInteger))
mean :: Fractional a ⇒ [a] → a
mean [] = 0
mean (x:xs) = mean' (x:xs) 0 0
where
mean' [] s c = s / c
mean' (x:xs) s c = mean' xs (s+x) (c+1)
data WLAN = WLAN
{
essid :: SSID,
quality :: Quality,
encryption :: Encryption,
mac :: MAC
}
deriving (Show, Read, Eq, Ord)
compact :: [WLAN] → [CWLAN]
compact [] = []
compact (w:ws) = CWLAN cid cen ceq_us : compact cne
where
cid = essid w
cen = encryption w
(ceq,cne) = partition ((cid ==) . essid) ws
ceq_us = macqual w : map macqual ceq
macqual = \ew → (mac ew, quality ew)
cellToWLAN :: Cell → WLAN
cellToWLAN c = WLAN (getEssid c) (getQuality c) (getEncrypt c) (getMac c)
where
getEssid = matching "ESSID:\"(.*)\""
getMac = matching "Address: (.{17})"
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.)" c of
"WPA " → WPA One
"WPA2" → WPA Two
_ → WEP
_ → None
getWLANs :: Interface → IO [WLAN]
getWLANs interface = return . map cellToWLAN =<< scan interface
getLocalIP :: Interface → IO IP
getLocalIP interface = return . matching "inet addr:(.+) ." =<< run ("ifconfig " ++ interface)
getESSID :: Interface → IO SSID
getESSID interface = return . matching "ESSID:\"(.+)\"" =<< run ("iwconfig " ++ interface)
getAP :: Interface → IO AP
getAP interface = return . matching "Access Point: (.+)\n" =<< run ("iwconfig " ++ interface)
data ConnectionStatus = NotConnected | Connected IP SSID
deriving (Show, Read, Eq, Ord)
getConnectionStatus :: Interface → IO ConnectionStatus
getConnectionStatus interface = do
ip ← getLocalIP interface
case ip of
[] → return NotConnected
ip → do
ap ← getAP interface
case (debug ap) of
"Not-Associated " → return NotConnected
ap → return . Connected ip =<< getESSID interface
matching :: String → String → String
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)
exec :: String → IO ()
exec cmd = runCommand cmd >>= waitForProcess >> return ()
pcom :: String → [String] → IO ()
pcom c = exec . unwords . (c:)
modprobe :: [String] → IO ()
modprobe = pcom "modprobe"
iwconfig :: [String] → IO ()
iwconfig = pcom "iwconfig"
ifconfig :: [String] → IO ()
ifconfig = pcom "ifconfig"
dhclient :: [String] → IO ()
dhclient = pcom "dhclient"
wpa_supplicant :: [String] → IO ()
wpa_supplicant = pcom "wpa_supplicant"
initHardware :: Driver → Interface → IO ()
initHardware driver interface = do
disconnect interface
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"
exec $ "killall wpa_supplicant"
ifconfig [interface, "down"]
connectFree :: Interface → SSID → IO ()
connectFree interface ssid = do
connect interface (Wireless ssid Nothing)
connect :: Interface → ConnectionSetting → IO ()
connect interface (Wireless ssid enc) = do
disconnect interface
ifconfig [interface, "up"]
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]
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
wpa_temp :: FilePath
wpa_temp = "/tmp/wpatemp.conf"
data ConnectionSetting = Wireless SSID (Maybe (Encryption,Key))
deriving (Show, Read, Eq, Ord)