hwall-auth-iitk (empty) → 0.1.0.0

raw patch · 5 files changed

+217/−0 lines, 5 filesdep +basedep +bytestringdep +haskelinesetup-changed

Dependencies added: base, bytestring, haskeline, http-conduit, http-types, mtl, regex-compat, unix

Files

• LICENSE +30/−0
• README +40/−0
• Setup.hs +2/−0
• hwall-auth-iitk.cabal +29/−0
• src/Main.hs +116/−0

@@ -0,0 +1,30 @@+Copyright (c) 2012, Satvik Chauhan++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Satvik Chauhan nor the names of other+      contributors may 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.

@@ -0,0 +1,40 @@+# IITK Authentication in Haskell+++Install using+```sh+cabal install+```++then simply run++```sh+hwall-auth-iitk+```++You can also supply username and password as command line arguments.++```sh+hwall-auth-iitk "username" "password"+```+++### Hardcoding Username and Password in the Executable++Add your username and password as stated in line 65 eg++```haskell+parse [] = return ("username","password")+```++comment the line++```haskell+-- parse _ = readInput+```++### Contributors++[Satvik Chauhan](https://github.com/satvikc)++[Jayesh Kumar Gupta](https://github.com/rejuvyesh)

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,29 @@+name:                hwall-auth-iitk+version:             0.1.0.0+synopsis:            Initial version of firewall Authentication for IITK network.+description:         Firewall Authentication script for IITK network in haskell.+license:             BSD3+license-file:        LICENSE+author:              satvikc+maintainer:          satvikc@iitk.ac.in+category:            Network+build-type:          Simple+extra-source-files:  README+cabal-version:       >=1.10++executable firewall-auth+  main-is:             Main.hs+  ghc-options:         -threaded+  Hs-source-dirs:      src+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.6 && <4.9,+                       bytestring,+                       haskeline,+                       http-conduit,+                       http-types,+                       mtl,+                       regex-compat >=0.95,+                       unix+  -- hs-source-dirs:+  default-language:    Haskell2010

@@ -0,0 +1,116 @@+import           Control.Arrow+import           Control.Applicative        (liftA2)+import           Control.Monad.Trans        (lift)+import           Control.Concurrent         (threadDelay)+import qualified Control.Exception          as E+import           Data.Maybe+import           Data.ByteString.Lazy       (ByteString)+import           Data.ByteString.Lazy.Char8 (unpack)+import           Data.ByteString.Char8      (pack)+import           Network.HTTP.Conduit+import           Network.HTTP.Types         (status200,status303)+import           System.Console.Haskeline+import           System.Environment+import           System.Exit+import           Text.Regex+++getResponse :: String -> IO (Response ByteString)+getResponse url = do+  request' <- parseUrl url+  let request = request' {redirectCount = 0,checkStatus = \_ _ _ -> Nothing}+  withManager $ httpLbs request++isLoggedIn :: IO (Either Bool (Response ByteString))+isLoggedIn = do+  res <- getResponse "http://74.125.236.51:80"+  return $ if responseStatus res /= status303 then Left True else Right res++getMagicString :: String -> Maybe [String]+getMagicString  = matchRegex $ mkRegex "VALUE=\"([0-9a-f]+)\""++getKeepAlive :: String -> Maybe [String]+getKeepAlive    = matchRegex $ mkRegex "location.href=\"(.+?)\""++getLogout :: String -> Maybe [String]+getLogout = matchRegex $ mkRegex "href=\"(.+?logout.+?)\""++keepAlive :: String -> String -> IO ()+keepAlive str logout = E.finally before after      --Logout if exit+  where+    before = do+      putStrLn "Sending Request to keep Alive"+      _ <- getResponse str+      threadDelay 200000000   -- Wait 200 seconds+      keepAlive str logout+    after = do+      status <- logOut logout+      if status+        then putStrLn "Logged out successfully"+        else putStrLn "Cannot logout"++usage :: IO ()+usage   = putStrLn "Version 0.1 beta \nUsage: hwall-auth-iitk [-h] username password"++readInput :: IO (String,String)+readInput = runInputT defaultSettings go+  where+    go :: InputT IO (String,String)+    go = do+      uname <- getInputLine "Username "+      pass <- getPassword Nothing "Password "+      maybe (lift exitFailure) return (liftA2 (,) uname pass)++parse :: [String] -> IO (String,String)+-- parse [] = return ("username","password")+parse ["-h"] = usage >> exitSuccess+parse ["--help"] = usage >> exitSuccess+parse (a:b:_) = return (a,b)+-- Comment this line if your are hardcoding your username and passoword.+parse _ = readInput++getAuthenticationInfo :: IO (String,String)+getAuthenticationInfo = getArgs >>= parse++alreadyLogged :: (String,String) -> Bool -> IO ()+alreadyLogged auth _ =  putStrLn "Already Logged in .. Trying after 60 seconds " >> threadDelay 60000000 >> firewallAuth auth+++logOut :: String -> IO Bool+logOut url = do+  resp <- getResponse url+  return (responseStatus resp == status200 )++tryToLog :: (String,String) -> Response ByteString -> IO ()+tryToLog (username,password) res = do+  putStrLn $ "Hello " ++ username ++ "\nNow trying to login"+  let authLocation = lookup "Location" (read (show $ responseHeaders res) :: [(String,String)])+  --print authLocation+  authRes <- getResponse (fromJust authLocation) -- Connecting to authentication Location+  let (magicString:_) = fromJust.getMagicString.unpack $ responseBody authRes+  --print magicString+  request <- parseUrl (fromJust authLocation)+  resp <- withManager.httpLbs $ urlEncodedBody (map (pack *** pack) [("username",username),("password",password),("magic",magicString),("4Tredir","/")]) request+  let body = responseBody resp+  --print body+  let (logout:_) = (fromJust.getLogout.unpack $ body)+  putStrLn ("Logout url is "++logout)+  --putStrLn $ "Logout Url" ++ (show $ responseHeaders resp)+  let keepAliveMatch = getKeepAlive $ unpack body+  case keepAliveMatch of+    Nothing -> putStrLn "Check Username or password" >> exitFailure+    Just (str:_) -> do+      putStrLn ("Keep Alive URL is "++str)+      keepAlive str logout++firewallAuth :: (String,String) -> IO ()+firewallAuth auth = do+  putStrLn "Checking If already Logged in."+  loggedin <- isLoggedIn                         -- Checking If Already Logged in+  putStrLn "Performing operation depending on current status."+  either (alreadyLogged auth) (tryToLog auth) loggedin++main :: IO ()+main = do+  auth <- getAuthenticationInfo   -- Getting Username and password+  firewallAuth auth