Quoted passwords

src-tests/data/test6a.netrc

@@ -0,0 +1 @@
+default login abc password """"

src-tests/data/test6a.netrc.out

@@ -0,0 +1 @@
+Right (NetRc {nrHosts = [NetRcHost {nrhName = "", nrhLogin = "abc", nrhPassword = "", nrhAccount = "", nrhMacros = []}], nrMacros = []})

src-tests/data/test6a.netrc.out2

@@ -0,0 +1 @@
+default login abc

src-tests/data/test6b.netrc

@@ -0,0 +1 @@
+default login abc password ""multi-word password""

src-tests/data/test6b.netrc.out

@@ -0,0 +1 @@
+Right (NetRc {nrHosts = [NetRcHost {nrhName = "", nrhLogin = "abc", nrhPassword = "multi-word password", nrhAccount = "", nrhMacros = []}], nrMacros = []})

src-tests/data/test6b.netrc.out2

@@ -0,0 +1 @@
+default login abc password ""multi-word password""

src-tests/data/test6c.netrc

@@ -0,0 +1 @@
+default login abc password ""unescape \\ backslash""

src-tests/data/test6c.netrc.out

@@ -0,0 +1 @@
+Right (NetRc {nrHosts = [NetRcHost {nrhName = "", nrhLogin = "abc", nrhPassword = "unescape \\ backslash", nrhAccount = "", nrhMacros = []}], nrMacros = []})

src-tests/data/test6c.netrc.out2

@@ -0,0 +1 @@
+default login abc password ""unescape \\ backslash""

src-tests/data/test6d.netrc

@@ -0,0 +1 @@
+default login abc password ""unescape \" quote""

src-tests/data/test6d.netrc.out

@@ -0,0 +1 @@
+Right (NetRc {nrHosts = [NetRcHost {nrhName = "", nrhLogin = "abc", nrhPassword = "unescape \" quote", nrhAccount = "", nrhMacros = []}], nrMacros = []})

src-tests/data/test6d.netrc.out2

@@ -0,0 +1 @@
+default login abc password ""unescape \" quote""

src-tests/data/test6e.netrc

@@ -0,0 +1 @@
+default login abc password ""unclosed-double-quotes

src-tests/data/test6e.netrc.out

@@ -0,0 +1 @@
+Right (NetRc {nrHosts = [NetRcHost {nrhName = "", nrhLogin = "abc", nrhPassword = "\"\"unclosed-double-quotes", nrhAccount = "", nrhMacros = []}], nrMacros = []})

src-tests/data/test6e.netrc.out2

@@ -0,0 +1 @@
+default login abc password ""unclosed-double-quotes

src-tests/data/test6f.netrc

@@ -0,0 +1 @@
+default login abc password ""password with # comment""

src-tests/data/test6f.netrc.out

@@ -0,0 +1 @@
+Right (NetRc {nrHosts = [NetRcHost {nrhName = "", nrhLogin = "abc", nrhPassword = "password with # comment", nrhAccount = "", nrhMacros = []}], nrMacros = []})

src-tests/data/test6f.netrc.out2

@@ -0,0 +1 @@
+default login abc password ""password with # comment""

src-tests/data/test6g.netrc

@@ -0,0 +1 @@
+default login abc password "single # quote should be treated as normal password"

src-tests/data/test6g.netrc.out

@@ -0,0 +1 @@
+Right (NetRc {nrHosts = [NetRcHost {nrhName = "", nrhLogin = "abc", nrhPassword = "\"single", nrhAccount = "", nrhMacros = []}], nrMacros = []})

src-tests/data/test6g.netrc.out2

@@ -0,0 +1 @@
+default login abc password "single

src/Network/NetRc.hs

@@ -27,6 +27,10 @@
 -- and after @machine@\/@default@\/@macdef@ entries. Be aware though
 -- that such @#@-comment are not supported by all @.netrc@-aware
 -- applications, including @ftp(1)@.
+--
+-- Passwords can contain spaces only if they are double-quoted, in which
+-- case backslashes and quotes are to be escaped with a preceding backslash.
+
 module Network.NetRc
     ( -- * Types
       NetRc(..)
@@ -128,7 +132,19 @@ netRcToBuilder (NetRc ms ds) =
               | otherwise      = BB.byteString "machine" <> spc <> BB.byteString nrhName
 
         prop lab val | B.null val = mempty
-                     | otherwise  = spc <> BB.byteString lab <> spc <> BB.byteString val
+                     | otherwise  = spc <> BB.byteString lab <> spc <> valString lab val
+
+        valString "password" val
+            | BC.elem ' ' val || BC.elem '\t' val
+              = BB.byteString "\"\""
+                <> BB.byteString (BC.concatMap (BC.pack . escape) val)
+                <> BB.byteString "\"\""
+            | otherwise = BB.byteString val
+          where
+            escape '\\' = "\\\\"
+            escape '\"' = "\\\""
+            escape x    = [ x ]
+        valString _ val = BB.byteString val
 
     netRcMacDefToBuilder (NetRcMacDef {..})
         = BB.byteString "macdef" <> spc <> BB.byteString nrmName <>
@@ -238,10 +254,14 @@ hostEnt = do
     -- pval := ((account|username|password) WS+ <value>)
     pval = hlp "login"    PValLogin   <|>
            hlp "account"  PValAccount <|>
-           hlp "password" PValPassword
+           hlpPassword
       where
         hlp tnam cons = P.try (P.string tnam) *> wsChars1 *>
                         (cons <$> tok P.<?> (tnam ++ "-value"))
+        hlpPassword   = P.try (P.string "password") *> wsChars1 *>
+                        (PValPassword <$> password P.<?> "password-value")
+        password = P.try quotedPassword <|> tok
+
 
     setFld n (PValLogin    v) = n { nrhLogin    = v }
     setFld n (PValAccount  v) = n { nrhAccount  = v }
@@ -250,6 +270,14 @@ hostEnt = do
 tok :: P.Parser ByteString
 tok = BC.pack <$> P.many1 notWsChar P.<?> "token"
 
+quotedPassword :: P.Parser ByteString
+quotedPassword = do
+  BC.pack <$> (P.string "\"\"" *> P.many chars <* P.string "\"\"")
+  where
+    chars = escaped <|> P.noneOf "\""
+    escaped = P.char '\\' >> P.choice [ P.char '\\' >> return '\\'
+                                      , P.char '"'  >> return '"' ]
+
 data PVal = PValLogin    !ByteString
           | PValAccount  !ByteString
           | PValPassword !ByteString
@@ -288,3 +316,4 @@ splitEithers = goL
     isLeft (Right _) = False
 
     isRight = not . isLeft
+