darcs 2.16.4 → 2.16.5
raw patch · 19 files changed
+241/−291 lines, 19 filesdep +regex-basedep +regex-tdfadep −regex-compat-tdfadep ~QuickCheckdep ~basedep ~cryptonite
Dependencies added: regex-base, regex-tdfa
Dependencies removed: regex-compat-tdfa
Dependency ranges changed: QuickCheck, base, cryptonite, memory
Files
- CHANGELOG +8/−0
- darcs.cabal +11/−10
- harness/Darcs/Test/Patch/Arbitrary/NamedPrim.hs +1/−1
- release/distributed-context +1/−1
- src/Darcs/Patch/Match.hs +1/−1
- src/Darcs/Repository/Prefs.hs +1/−2
- src/Darcs/Repository/State.hs +9/−11
- src/Darcs/UI/Commands/Send.hs +14/−44
- src/Darcs/UI/Commands/ShowAuthors.hs +1/−1
- src/Darcs/UI/External.hs +104/−156
- src/Darcs/UI/Flags.hs +5/−4
- src/Darcs/UI/Options/All.hs +2/−16
- src/Darcs/UI/SelectChanges.hs +5/−1
- src/Darcs/Util/Regex.hs +54/−0
- src/system_encoding.c +0/−10
- src/system_encoding.h +0/−11
- tests/issue1344_abort_early_cant_send.sh +5/−3
- tests/network/external.sh +19/−16
- tests/send-external.sh +0/−3
CHANGELOG view
@@ -1,3 +1,11 @@+Darcs 2.16.5, 20 Feb 2022++ This release is to support newer dependencies, most importantly+ GHC 9.0 and Cabal 3.6.++ It also includes a small number of refactors that help with moving+ to those newer dependencies.+ Darcs 2.16.4, 20 May 2021 This release is mostly to fix http://bugs.darcs.net/issue2674 which can
darcs.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.4 Name: darcs-version: 2.16.4+version: 2.16.5 License: GPL-2.0-or-later License-file: COPYING Author: David Roundy <droundy@darcs.net>, <darcs-devel@darcs.net>@@ -131,8 +131,8 @@ -- ---------------------------------------------------------------------- custom-setup- setup-depends: base >= 4.10 && < 4.15,- Cabal >= 2.2 && < 3.3,+ setup-depends: base >= 4.10 && < 4.16,+ Cabal >= 2.4 && < 3.7, process >= 1.2.3.0 && < 1.7, filepath >= 1.4.1 && < 1.5.0.0, directory >= 1.2.7 && < 1.4@@ -376,6 +376,7 @@ Darcs.Util.Progress Darcs.Util.Prompt Darcs.Util.Ratified+ Darcs.Util.Regex Darcs.Util.Show Darcs.Util.SignalHandler Darcs.Util.Ssh@@ -393,7 +394,6 @@ c-sources: src/atomic_create.c src/maybe_relink.c src/umask.c- src/system_encoding.c -- see http://bugs.darcs.net/issue1037 cc-options: -D_REENTRANT@@ -409,17 +409,18 @@ System.Posix System.Posix.Files System.Posix.IO- cpp-options: -DWIN32 -DHAVE_MAPI+ cpp-options: -DWIN32 c-sources: src/win32/send_email.c build-depends: Win32 >= 2.4.0 && < 2.7 else build-depends: unix >= 2.7.1.0 && < 2.8 - build-depends: base >= 4.10 && < 4.15,+ build-depends: base >= 4.10 && < 4.16, stm >= 2.1 && < 2.6, binary >= 0.5 && < 0.11, containers >= 0.5.6.2 && < 0.7,- regex-compat-tdfa >= 0.95.1 && < 0.96,+ regex-base >= 0.94.0.1 && < 0.94.1,+ regex-tdfa >= 1.3.1.0 && < 1.3.2, regex-applicative >= 0.2 && < 0.4, mtl >= 2.2.1 && < 2.3, transformers >= 0.4.2.0 && < 0.6,@@ -428,8 +429,8 @@ html >= 1.0.1.2 && < 1.1, filepath >= 1.4.1 && < 1.5.0.0, haskeline >= 0.7.2 && < 0.9,- memory >= 0.14 && < 0.16,- cryptonite >= 0.24 && < 0.28,+ memory >= 0.14 && < 0.17,+ cryptonite >= 0.24 && < 0.30, base16-bytestring >= 0.1.1.7 && < 1.1, utf8-string >= 1 && < 1.1, vector >= 0.11 && < 0.13,@@ -576,7 +577,7 @@ text, directory, FindBin >= 0.0.5 && < 0.1,- QuickCheck >= 2.13 && < 2.14,+ QuickCheck >= 2.13 && < 2.15, leancheck >= 0.9 && < 0.10, HUnit >= 1.3 && < 1.7, test-framework >= 0.8.1.1 && < 0.9,
harness/Darcs/Test/Patch/Arbitrary/NamedPrim.hs view
@@ -3,7 +3,7 @@ import Prelude () import Darcs.Prelude-import Test.QuickCheck+import Test.QuickCheck ( arbitrarySizedNatural, suchThat, Gen ) import Test.QuickCheck.Gen ( chooseAny ) import Darcs.Patch.Prim.Named ( NamedPrim, namedPrim, PrimPatchId, unsafePrimPatchId )
release/distributed-context view
@@ -1,1 +1,1 @@-Just "\nContext:\n\n\n[TAG 2.16.4\nBen Franksen <ben.franksen@online.de>**20210520120106\n Ignore-this: 6ad053de84a2b3fcd9dc62076e0fbbad24d8c25ef4a659a163cadc1832b39686aa41a2b7a12928df\n] \n"+Just "\nContext:\n\n[TAG 2.16.5\nGanesh Sittampalam <ganesh@earth.li>**20220220083531\n Ignore-this: 51417cb5dd488dc0d962ffb051f63ee1\n] \n"
src/Darcs/Patch/Match.hs view
@@ -90,7 +90,7 @@ , Operator ( Infix, Prefix ) , buildExpressionParser )-import Text.Regex ( mkRegex, matchRegex )+import Darcs.Util.Regex ( mkRegex, matchRegex ) import Control.Exception ( Exception, throw ) import Data.Maybe ( isJust )
src/Darcs/Repository/Prefs.hs view
@@ -30,7 +30,6 @@ , changePrefval , defPrefval , writeDefaultPrefs- , boringRegexps , isBoring , FileType(..) , filetypeFunction@@ -66,7 +65,6 @@ import System.IO ( stdout, stderr ) import System.Info ( os ) import System.Posix.Files ( getFileStatus, fileOwner )-import Text.Regex ( Regex, mkRegex, matchRegex ) import Darcs.Repository.Cache ( Cache, mkCache, CacheType(..), CacheLoc(..), WritableOrNot(..) )@@ -84,6 +82,7 @@ import Darcs.Util.Path ( AbsolutePath, ioAbsolute, toFilePath, getCurrentDirectory ) import Darcs.Util.Printer( hPutDocLn, text )+import Darcs.Util.Regex ( Regex, mkRegex, matchRegex ) import Darcs.Util.URL ( isValidLocalPath ) import Darcs.Util.File ( osxCacheDir, xdgCacheDir, removeFileMayNotExist )
src/Darcs/Repository/State.hs view
@@ -42,10 +42,8 @@ import Control.Monad ( when, foldM, forM, void ) import Control.Monad.State ( StateT, runStateT, get, put, liftIO ) import Control.Exception ( catch, IOException )-import Data.Maybe ( isJust ) import Data.Ord ( comparing ) import Data.List ( sortBy, union, delete )-import Text.Regex( matchRegex ) import System.Directory( doesFileExist, doesDirectoryExist, renameFile ) import System.FilePath ( (<.>), (</>) )@@ -82,7 +80,7 @@ import Darcs.Repository.InternalTypes ( Repository, repoFormat, repoLocation ) import Darcs.Repository.Format(formatHas, RepoProperty(NoWorkingDir)) import qualified Darcs.Repository.Pending as Pending-import Darcs.Repository.Prefs ( filetypeFunction, boringRegexps )+import Darcs.Repository.Prefs ( filetypeFunction, isBoring ) import Darcs.Repository.Diff ( treeDiff ) import Darcs.Repository.Inventory ( peekPristineHash, getValidHash ) import Darcs.Repository.Paths@@ -99,7 +97,7 @@ import Darcs.Util.Global ( debugMessage ) import Darcs.Util.Path ( AnchoredPath- , anchorPath+ , realPath , filterPaths , inDarcsdir , parents@@ -174,14 +172,14 @@ -- to darcs. The result is usually applied to the full working state. restrictBoring :: Tree m -> IO (TreeFilter m) restrictBoring guide = do- boring <- boringRegexps- let boring' p | inDarcsdir p = False- boring' p = not $ any (\rx -> isJust $ matchRegex rx p') boring- where p' = anchorPath "" p+ boring <- isBoring+ let exclude p = inDarcsdir p || boring (realPath p) restrictTree :: FilterTree t m => t m -> t m- restrictTree = Tree.filter $ \p _ -> case find guide p of- Nothing -> boring' p- _ -> True+ restrictTree =+ Tree.filter $ \p _ ->+ case find guide p of+ Nothing -> not (exclude p)+ _ -> True return (TreeFilter restrictTree) -- | Construct a Tree filter that removes any darcs metadata files the
src/Darcs/UI/Commands/Send.hs view
@@ -15,20 +15,14 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-} module Darcs.UI.Commands.Send ( send ) where import Darcs.Prelude import System.Directory ( renameFile )-import System.Exit- ( exitSuccess-#ifndef HAVE_MAPI- , ExitCode ( ExitFailure )- , exitWith-#endif- )+import System.Exit ( exitSuccess ) import System.IO ( hClose ) import Control.Exception ( catch, IOException, onException ) import Control.Monad ( when, unless, forM_ )@@ -105,11 +99,7 @@ , sendEmailDoc , generateEmail , editFile- , getSystemEncoding- , isUTF8Locale-#ifndef HAVE_MAPI- , haveSendmail-#endif+ , checkDefaultSendmail ) import Darcs.Util.ByteString ( mmapFilePS, isAscii ) import qualified Data.ByteString.Char8 as BC (unpack)@@ -179,7 +169,8 @@ ^ O.headerFields ^ O.author ^ O.charset- ^ O.sendmail+ ^ O.mail+ ^ O.sendmailCmd ^ O.output ^ O.sign ^ O.dryRunXml@@ -203,6 +194,12 @@ sendCmd (_,o) opts [unfixedrepodir] = withRepository (useCache ? opts) $ RepoJob $ \(repository :: Repository rt p wR wU wR) -> do+ when (O.mail ? opts && dryRun ? opts == O.NoDryRun) $ do+ -- If --mail is used and the user has not provided a --sendmail-command+ -- and we can detect that the system has no default way to send emails, + -- then we want to fail early i.e. before asking the user any questions.+ sm_cmd <- getSendmailCmd opts+ when (isNothing sm_cmd) checkDefaultSendmail case O.sendToContext ? opts of Just contextfile -> do wtds <- decideOnBehavior opts (Nothing :: Maybe (Repository rt p wR wU wR))@@ -230,16 +227,6 @@ => Repository rt p wR wU wT -> [DarcsFlag] -> [WhatToDo] -> String -> PatchSet rt p Origin wX -> IO () sendToThem repo opts wtds their_name them = do-#ifndef HAVE_MAPI- when (fst (O.sendmail ? opts) && dryRun ? opts == O.NoDryRun) $ do- -- If --mail is used, check if the user has sendmail or- -- provided a --sendmail-cmd- sendmail <- haveSendmail- sm_cmd <- getSendmailCmd opts- when (not sendmail && sm_cmd == "") $ do- putInfo opts noWorkingSendmail- exitWith $ ExitFailure 1-#endif us <- readRepo repo common :> us' <- return $ findCommonWithThem us them checkUnrelatedRepos (O.allowUnrelatedRepos ? opts) us them@@ -276,7 +263,7 @@ fname <- make_fname to_be_sent let outname = case getOutput opts fname of Just f -> Just f- Nothing | fst (O.sendmail ? opts) -> Nothing+ Nothing | O.mail ? opts -> Nothing | not $ null [ p | Post p <- wtds] -> Nothing | otherwise -> Just (makeAbsoluteOrStd here fname) case outname of@@ -339,13 +326,7 @@ Nothing -> do warnCharset charsetCouldNotGuess return mailcharset- Just "utf-8" -> do- -- Check the locale encoding for consistency- encoding <- getSystemEncoding- debugMessage $ currentEncodingIs encoding- unless (isUTF8Locale encoding) $- warnCharset charsetUtf8MailDiffLocale- return mailcharset+ Just "utf-8" -> return mailcharset -- Trust other cases (us-ascii) Just _ -> return mailcharset @@ -359,8 +340,8 @@ sendmail = (do- sm_cmd <- getSendmailCmd opts let to = generateEmailToString thetargets+ sm_cmd <- getSendmailCmd opts sendEmailDoc from to thesubject (getCc opts) sm_cmd contentAndBundle body putInfo opts (success to (getCc opts)))@@ -600,11 +581,6 @@ creatingPatch :: String -> Doc creatingPatch repodir = "Creating patch to" <+> quoted repodir <> "..." -#ifndef HAVE_MAPI-noWorkingSendmail :: Doc-noWorkingSendmail = "No working sendmail instance on your machine!"-#endif- nothingSendable :: Doc nothingSendable = "No recorded local changes to send!" @@ -625,12 +601,6 @@ charsetCouldNotGuess :: String charsetCouldNotGuess = "darcs could not guess the charset of your mail."--currentEncodingIs :: String -> String-currentEncodingIs e = "Current locale encoding: " ++ e--charsetUtf8MailDiffLocale :: String-charsetUtf8MailDiffLocale = "your mail is valid UTF-8 but your locale differs." aborted :: Doc aborted = "Aborted."
src/Darcs/UI/Commands/ShowAuthors.hs view
@@ -28,7 +28,6 @@ import System.IO.Error ( catchIOError ) import Text.ParserCombinators.Parsec hiding ( lower, count, Line ) import Text.ParserCombinators.Parsec.Error-import Text.Regex ( Regex, mkRegexWithOpts, matchRegex ) import Darcs.Prelude @@ -46,6 +45,7 @@ import Darcs.Util.Lock ( readTextFile ) import Darcs.Util.Printer ( Doc, text ) import Darcs.Util.Path ( AbsolutePath )+import Darcs.Util.Regex ( Regex, mkRegexWithOpts, matchRegex ) data Spelling = Spelling String String [Regex] -- name, email, regexps type ParsedLine = Maybe Spelling -- Nothing for blank lines
src/Darcs/UI/External.hs view
@@ -4,7 +4,6 @@ ( sendEmail , generateEmail , sendEmailDoc- , resendEmail , signString , verifyPS , execDocPipe@@ -12,33 +11,43 @@ , pipeDocSSH , viewDoc , viewDocWith- , haveSendmail- , sendmailPath+ , checkDefaultSendmail , diffProgram , darcsProgram , editText , editFile -- * Locales , setDarcsEncodings- , getSystemEncoding- , isUTF8Locale ) where import Darcs.Prelude -import Data.Maybe ( isJust, isNothing, maybeToList )-import Control.Monad ( unless, when, filterM, liftM2, void )+import Data.Maybe ( isJust )+#ifndef WIN32+import Data.Maybe ( isNothing, maybeToList )+#endif+import Control.Monad ( unless, when, filterM, void )+#ifndef WIN32+import Control.Monad ( liftM2 )+#endif import Control.Concurrent.MVar ( MVar ) import System.Exit ( ExitCode(..) ) import System.Environment ( getEnv , getExecutablePath )-import System.IO ( hPutStr, hPutStrLn, hClose,- hIsTerminalDevice, stdout, stderr, Handle )-import System.Directory ( doesFileExist,- findExecutable )+import System.Directory ( doesFileExist, findExecutable )+import System.IO+ ( Handle+ , hClose+ , hIsTerminalDevice+ , hPutStr+ , stderr+ , stdout+ )+#ifndef WIN32 import System.FilePath.Posix ( (</>) )+#endif import System.Process ( createProcess, proc, CreateProcess(..), runInteractiveProcess, waitForProcess, StdStream(..) ) import System.Process.Internals ( ProcessHandle ) @@ -49,19 +58,12 @@ , setLocaleEncoding ) #endif -import Foreign.C.String ( CString, peekCString )- import Control.Concurrent ( forkIO, newEmptyMVar, putMVar, takeMVar )-import Control.Exception- ( try, finally, catch, IOException )+import Control.Exception ( IOException, finally, try ) import System.IO.Error ( ioeGetErrorType ) import GHC.IO.Exception ( IOErrorType(ResourceVanished) )-import Data.Char ( toLower )-import Text.Regex-#if defined (HAVE_MAPI)+#ifdef WIN32 import Foreign.C ( withCString )-#endif-#ifdef HAVE_MAPI import Foreign.Ptr ( nullPtr ) import Darcs.Util.Lock ( canonFilename, writeDocBinFile ) #endif@@ -75,10 +77,8 @@ import Darcs.Util.Progress ( withoutProgress, debugMessage ) import Darcs.Util.ByteString (linesPS, unlinesPS)-import qualified Data.ByteString as B (ByteString, empty, null, readFile- ,hGetContents, writeFile, hPut, length- ,take, concat, drop, isPrefixOf, singleton, append)-import qualified Data.ByteString.Char8 as BC (unpack, pack)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC import Darcs.Util.Lock ( withTemp@@ -87,24 +87,42 @@ ) import Darcs.Util.Ssh ( getSSH, SSHCmd(..) ) import Darcs.Util.CommandLine ( parseCmd, addUrlencoded )+#ifndef WIN32+import Darcs.Util.English ( orClauses )+#endif import Darcs.Util.Exception ( catchall ) import Darcs.Util.Exec ( execInteractive, exec, Redirect(..), withoutNonBlock ) import Darcs.Util.URL ( SshFilePath, sshUhost )-import Darcs.Util.Printer ( Doc, Printers, hPutDocLnWith, hPutDoc, hPutDocLn, hPutDocWith, ($$), renderPS,- simplePrinters,- hPutDocCompr,- text, empty, packedString, vcat, renderString )+import Darcs.Util.Printer+ ( Doc+ , Printers+ , hPutDoc+ , hPutDocCompr+ , hPutDocLn+ , hPutDocLnWith+ , hPutDocWith+ , packedString+ , renderPS+ , renderString+ , simplePrinters+ , text+ ) import qualified Darcs.Util.Ratified as Ratified import Darcs.UI.Email ( formatHeader ) +#ifndef WIN32 sendmailPath :: IO String sendmailPath = do+ let searchPath = [ "/usr/sbin", "/sbin", "/usr/lib" ] l <- filterM doesFileExist $ liftM2 (</>)- [ "/usr/sbin", "/sbin", "/usr/lib" ]+ searchPath [ "sendmail" ] ex <- findExecutable "sendmail"- when (isNothing ex && null l) $ fail "Cannot find the \"sendmail\" program."+ when (isNothing ex && null l) $+ fail $ "Cannot find the 'sendmail' program in " +++ orClauses ("your PATH" : searchPath) ++ "." return $ head $ maybeToList ex ++ l+#endif diffProgram :: IO String diffProgram = do@@ -144,7 +162,7 @@ (ssh, ssh_args) <- getSSH SSH pipeDocInternal (PipeToSsh compress) ssh (ssh_args ++ ("--":sshUhost remoteAddr:args)) input -sendEmail :: String -> String -> String -> String -> String -> String -> IO ()+sendEmail :: String -> String -> String -> String -> Maybe String -> String -> IO () sendEmail f t s cc scmd body = sendEmailDoc f t s cc scmd Nothing (text body) @@ -168,8 +186,19 @@ = B.hPut h (B.append (formatHeader field value) newline) newline = B.singleton 10 -haveSendmail :: IO Bool-haveSendmail = (sendmailPath >> return True) `catch` (\(_ :: IOException) -> return False)+checkDefaultSendmail :: IO ()+#ifndef WIN32+checkDefaultSendmail = void sendmailPath+#else+-- FIXME find a way to detect if sending via MAPI would work+checkDefaultSendmail = return ()+{-+ TODO do we want a warning message like this one here?+ hPutStr stderr+ "Warning: Using MAPI for sending mail. This may hang indefinitely " +++ "if not properly configured.\n"+-}+#endif -- | Send an email, optionally containing a patch bundle -- (more precisely, its description and the bundle itself)@@ -178,35 +207,16 @@ -> String -- ^ to -> String -- ^ subject -> String -- ^ cc- -> String -- ^ send command+ -> Maybe String -- ^ send command -> Maybe (Doc, Doc) -- ^ (content,bundle) -> Doc -- ^ body -> IO () sendEmailDoc _ "" _ "" _ _ _ = return () sendEmailDoc f "" s cc scmd mbundle body = sendEmailDoc f cc s "" scmd mbundle body-sendEmailDoc f t s cc scmd mbundle body = do- use_sendmail <- haveSendmail- if use_sendmail || scmd /= "" then- withOpenTemp $ \(h,fn) -> do- generateEmail h f t s cc body- hClose h- withOpenTemp $ \(hat,at) -> do- ftable' <- case mbundle of- Just (content,bundle) -> do- hPutDocLn hat bundle- return [ ('b', renderString content) , ('a', at) ]- Nothing ->- return [ ('b', renderString body) ]- hClose hat- let ftable = [ ('t',addressOnly t),('c',cc),('f',f),('s',s) ] ++ ftable'- r <- execSendmail ftable scmd fn- when (r /= ExitSuccess) $ fail ("failed to send mail to: "- ++ t ++ cc_list cc- ++ "\nPerhaps sendmail is not configured.")-#ifdef HAVE_MAPI- else do- r <- withCString t $ \tp ->+#ifdef WIN32+sendEmailDoc f t s cc Nothing _mbundle body = do+ r <- withCString t $ \tp -> withCString f $ \fp -> withCString cc $ \ccp -> withCString s $ \sp ->@@ -217,71 +227,53 @@ cfn <- canonFilename fn withCString cfn $ \pcfn -> c_send_email fp tp ccp sp nullPtr pcfn- when (r /= 0) $ fail ("failed to send mail to: " ++ t)-#else- else fail "no mail facility (sendmail or mapi) located at configure time!"+ when (r /= 0) $ do+ fail $ "Failed to send mail via MAPI to: " ++ recipients t cc #endif+sendEmailDoc f t s cc scmd mbundle body =+ withOpenTemp $ \(h,fn) -> do+ generateEmail h f t s cc body+ hClose h+ withOpenTemp $ \(hat,at) -> do+ ftable' <- case mbundle of+ Just (content,bundle) -> do+ hPutDocLn hat bundle+ return [ ('b', renderString content) , ('a', at) ]+ Nothing ->+ return [ ('b', renderString body) ]+ hClose hat+ let ftable = [ ('t',addressOnly t),('c',cc),('f',f),('s',s) ] ++ ftable'+ r <- execSendmail ftable scmd fn+ when (r /= ExitSuccess) $+ fail ("Failed to send mail to: " ++ recipients t cc) where addressOnly a = case dropWhile (/= '<') a of ('<':a2) -> takeWhile (/= '>') a2 _ -> a - cc_list [] = []- cc_list c = " and cc'ed " ++ c+recipients :: String -> String -> String+recipients to "" = to+recipients to cc = to ++ " and cc'ed " ++ cc -resendEmail :: String -> String -> B.ByteString -> IO ()-resendEmail "" _ _ = return ()-resendEmail t scmd body = do- use_sendmail <- haveSendmail- if use_sendmail || scmd /= ""- then- withOpenTemp $ \(h,fn) -> do- hPutStrLn h $ "To: "++ t- hPutStrLn h $ find_from (linesPS body)- hPutStrLn h $ find_subject (linesPS body)- hPutDocLn h $ fixit $ linesPS body- hClose h- let ftable = [('t',t)]- r <- execSendmail ftable scmd fn- when (r /= ExitSuccess) $ fail ("failed to send mail to: " ++ t)- else-#ifdef HAVE_MAPI- fail "Don't know how to resend email with MAPI"+execSendmail :: [(Char,String)] -> Maybe String -> String -> IO ExitCode+#ifdef WIN32+execSendmail _ Nothing _ = error "impossible" #else- fail "no mail facility (sendmail or mapi) located at configure time (use the sendmail-command option)!"+execSendmail _ Nothing fn = do+ scmd <- sendmailPath+ exec scmd ["-i", "-t"] (File fn, Null, AsIs) #endif- where br = BC.pack "\r"- darcsurl = BC.pack "DarcsURL:"- content = BC.pack "Content-"- from_start = BC.pack "From:"- subject_start = BC.pack "Subject:"- fixit (l:ls)- | B.null l = packedString B.empty $$ vcat (map packedString ls)- | l == br = packedString B.empty $$ vcat (map packedString ls)- | B.take 9 l == darcsurl || B.take 8 l == content- = packedString l $$ fixit ls- | otherwise = fixit ls- fixit [] = empty- find_from (l:ls) | B.take 5 l == from_start = BC.unpack l- | otherwise = find_from ls- find_from [] = "From: unknown"- find_subject (l:ls) | B.take 8 l == subject_start = BC.unpack l- | otherwise = find_subject ls- find_subject [] = "Subject: (no subject)"--execSendmail :: [(Char,String)] -> String -> String -> IO ExitCode-execSendmail ftable scmd fn =- if scmd == "" then do- cmd <- sendmailPath- exec cmd ["-i", "-t"] (File fn, Null, AsIs)- else case parseCmd (addUrlencoded ftable) scmd of- Right (arg0:opts, wantstdin) ->- do let stdin = if wantstdin then File fn else Null- exec arg0 opts (stdin, Null, AsIs)- Left e -> fail $ "failed to send mail, invalid sendmail-command: "++show e- _ -> fail "failed to send mail, invalid sendmail-command"+execSendmail ftable (Just scmd) fn =+ case parseCmd (addUrlencoded ftable) scmd of+ Right (arg0:opts, wantstdin) ->+ let stdin = if wantstdin then File fn else Null+ in exec arg0 opts (stdin, Null, AsIs)+ Right ([], _) ->+ fail $ "Invalid sendmail-command "++show scmd+ Left e ->+ fail $ "Invalid sendmail-command "++show scmd++"\n"++show e -#ifdef HAVE_MAPI+#ifdef WIN32 foreign import ccall "win32/send_email.h send_email" c_send_email :: CString -> {- sender -} CString -> {- recipient -}@@ -370,7 +362,7 @@ fix_line x | B.length x < 3 = x | BC.pack "- -" `B.isPrefixOf` x = B.drop 2 x | otherwise = x-#if defined(WIN32)+#ifdef WIN32 fix_sep c | c=='/' = '\\' | otherwise = c fix_path p = map fix_sep p #else@@ -550,47 +542,3 @@ setForeignEncoding e setLocaleEncoding e #endif---- The following functions are copied from the encoding package (BSD3--- licence, by Henning Günther).---- | @getSystemEncoding@ fetches the current encoding from locale-foreign import ccall "system_encoding.h get_system_encoding"- get_system_encoding :: IO CString---getSystemEncoding :: IO String-getSystemEncoding = do- enc <- get_system_encoding- peekCString enc----- | @isUTF8@ checks if an encoding is UTF-8 (or ascii, since it is a--- subset of UTF-8).-isUTF8Locale :: String -> Bool-isUTF8Locale codeName = case normalizeEncoding codeName of- -- ASCII- "ascii" -> True- "646" -> True- "ansi_x3_4_1968" -> True- "ansi_x3.4_1986" -> True- "cp367" -> True- "csascii" -> True- "ibm367" -> True- "iso646_us" -> True- "iso_646.irv_1991" -> True- "iso_ir_6" -> True- "us" -> True- "us_ascii" -> True- -- UTF-8- "utf_8" -> True- "u8" -> True- "utf" -> True- "utf8" -> True- "utf8_ucs2" -> True- "utf8_ucs4" -> True- -- Everything else- _ -> False- where- normalizeEncoding s = map toLower $ subRegex sep s "_"- sep = mkRegex "[^0-9A-Za-z]+"
src/Darcs/UI/Flags.hs view
@@ -454,10 +454,11 @@ -- This flag is present if darcs was invoked with @--sendmail-command=COMMAND@ -- Alternatively the user can set @$S@@ENDMAIL@ which will be used as a -- fallback if present.-getSendmailCmd :: Config -> IO String-getSendmailCmd fs = case parseFlags O.sendmailCmd fs of- Just cmd -> return cmd- Nothing -> fmap (maybe "" id) $ lookupEnv "SENDMAIL"+getSendmailCmd :: Config -> IO (Maybe String)+getSendmailCmd fs =+ case parseFlags O.sendmailCmd fs of+ Nothing -> lookupEnv "SENDMAIL"+ justcmd -> return justcmd -- | Accessor for output option getOutput :: Config -> FilePath -> Maybe AbsolutePathOrStd
src/Darcs/UI/Options/All.hs view
@@ -140,7 +140,7 @@ , HeaderFields (..) , headerFields , sendToContext- , sendmail+ , mail , sendmailCmd , charset , editDescription@@ -900,20 +900,6 @@ where arg (F.Context s) = Just s arg _ = Nothing --- TODO: do something about the nonsensical case (False, Just s)------ Some of the tests actually do this (pass --sendmail-command without--- passing --mail) and it's unclear if it's deliberate or just a historical--- accident after the issue2204 changes. We should untangle that and--- perhaps turn this into a single option with an optional argument.--- The other question to resolve is the interaction with the 'output'--- options to darcs send.-sendmailIso :: Iso (Bool -> Maybe String -> a) ((Bool, Maybe String) -> a)-sendmailIso = Iso uncurry curry--sendmail :: PrimDarcsOption (Bool, Maybe String)-sendmail = imap sendmailIso $ mail ^ sendmailCmd- mail :: PrimDarcsOption Bool mail = singleNoArg [] ["mail"] F.Mail "send patch using sendmail" @@ -1005,7 +991,7 @@ , RawNoArg [] ["skip-conflicts"] F.SkipConflicts Nothing "filter out any patches that would create conflicts" ] --- Technically not an isomorphism, see 'sendmailIso'.+-- Technically not an isomorphism. externalMerge :: PrimDarcsOption ExternalMerge externalMerge = imap (Iso fw bw) $ singleStrArg [] ["external-merge"] F.ExternalMerge arg "COMMAND" "use external tool to merge conflicts"
src/Darcs/UI/SelectChanges.hs view
@@ -346,7 +346,11 @@ -- after selecting with a splitter, the results may not be canonical canonizeAfterSplitter :: (FL p :> FL p) wA wB -> (FL p :> FL p) wA wB canonizeAfterSplitter (x :> y) =- let canonizeIfNeeded = maybe id canonizeSplit mspl+ let+ canonizeIfNeeded =+ case mspl of+ Just s -> canonizeSplit s+ Nothing -> id in canonizeIfNeeded x :> canonizeIfNeeded y -- retrieve the results of patch selection
+ src/Darcs/Util/Regex.hs view
@@ -0,0 +1,54 @@+-- | This module is a subset of the defunct regex-compat-tdfa.+module Darcs.Util.Regex+ ( Regex+ , mkRegex+ , mkRegexWithOpts+ , matchRegex+ ) where++import Darcs.Prelude++import Text.Regex.Base+ ( RegexContext(matchM)+ , RegexMaker(makeRegexOpts)+ , defaultCompOpt+ , defaultExecOpt+ )+import Text.Regex.TDFA (Regex, caseSensitive, multiline, newSyntax)++-- | Makes a regular expression with the default options (multi-line,+-- case-sensitive). The syntax of regular expressions is+-- otherwise that of @egrep@ (i.e. POSIX \"extended\" regular+-- expressions).+mkRegex :: String -> Regex+mkRegex s = makeRegexOpts opt defaultExecOpt s+ where+ opt = defaultCompOpt {newSyntax = True, multiline = True}++-- | Makes a regular expression, where the multi-line and+-- case-sensitive options can be changed from the default settings.+mkRegexWithOpts+ :: String -- ^ The regular expression to compile+ -> Bool -- ^ 'True' @\<=>@ @\'^\'@ and @\'$\'@ match the beginning and + -- end of individual lines respectively, and @\'.\'@ does /not/+ -- match the newline character.+ -> Bool -- ^ 'True' @\<=>@ matching is case-sensitive+ -> Regex -- ^ Returns: the compiled regular expression+mkRegexWithOpts s single_line case_sensitive+ = let opt = defaultCompOpt+ { multiline = (if single_line then True else False)+ , caseSensitive = (if case_sensitive then True else False)+ , newSyntax = True }+ in makeRegexOpts opt defaultExecOpt s++-- | Match a regular expression against a string+matchRegex ::+ Regex -- ^ The regular expression+ -> String -- ^ The string to match against+ -> Maybe [String] -- ^ Returns: @'Just' strs@ if the match succeeded+ -- (and @strs@ is the list of subexpression matches),+ -- or 'Nothing' otherwise.+matchRegex p str = fmap go (matchM p str)+ where+ go :: (String, String, String, [String]) -> [String]+ go (_, _, _, ss) = ss
− src/system_encoding.c
@@ -1,10 +0,0 @@-#include "system_encoding.h"--char* get_system_encoding() {-#ifdef WIN32- return "utf8";-#else- setlocale(LC_ALL,"");- return nl_langinfo(CODESET);-#endif-}
− src/system_encoding.h
@@ -1,11 +0,0 @@-#ifndef __SYSTEM_ENCODING__-#define __SYSTEM_ENCODING__--#ifndef WIN32-#include <langinfo.h>-#include <locale.h>-#endif--char* get_system_encoding();--#endif
tests/issue1344_abort_early_cant_send.sh view
@@ -26,8 +26,9 @@ . ./lib -# The mail sending code on Windows uses the MAPI API unconditionally-# so this test fails.+# The mail sending code on Windows uses the MAPI API if there is no+# sendmail-command configured using either option or environment+# variable. # If it's possible to discover in advance whether mail sending would work, # the code and this test could be improved to do that. abort_windows@@ -66,6 +67,7 @@ darcs send --author=me -a --to=random@random -O ../temp2 darcs send --author=me -a --to=random@random -o test.patch ../temp2 # Otherwise, fail early-(darcs send --mail --author=me -a --to=random@random ../temp2 || true) | grep "No working sendmail"+not darcs send --mail --author=me -a --to=random@random ../temp2 2>log+grep "Cannot find the 'sendmail' program" log cd ..
tests/network/external.sh view
@@ -5,33 +5,36 @@ . lib rm -rf temp1+rm -f fakessh -touch_fakessh='./touch-fakessh'-if echo $OS | grep -i windows; then- touch_fakessh="touch_fakessh.bat"+# make our ssh command one word only+if os_is_windows; then+ fakessh=fakessh.bat+ echo 'echo hello > touchedby_fakessh' > $fakessh+else+ fakessh=./fakessh+ echo '#!/bin/sh' > $fakessh+ echo 'echo hello > touchedby_fakessh' >> $fakessh fi-export DARCS_SSH=$touch_fakessh-export DARCS_SCP=$touch_fakessh-export DARCS_SFTP=$touch_fakessh-rm -rf 'fakessh'-rm -rf 'touch-fakessh'+chmod u+x $fakessh -# make our ssh command one word only-echo 'echo hello > fakessh' > $touch_fakessh-chmod u+x $touch_fakessh+export DARCS_SSH=$fakessh+export DARCS_SCP=$fakessh+export DARCS_SFTP=$fakessh+ # first test the DARCS_SSH environment variable+rm -rf touchedby_fakessh not darcs clone example.com:foo-grep hello fakessh-rm -f fakessh+grep hello touchedby_fakessh # now make sure that we don't launch ssh for nothing+rm -f touchedby_fakessh mkdir temp1 cd temp1 darcs init cd .. darcs clone temp1 > log-not grep fakessh log+not grep touchedby_fakessh log not darcs clone http://darcs.net/nonexistent-not grep fakessh log+not grep touchedby_fakessh log cd ..-rm -rf temp1
tests/send-external.sh view
@@ -2,9 +2,6 @@ . ./lib # The argument quoting in the test script below breaks on Windows paths-# Actually sending email from Windows is very unlikely anyway, so just-# skip this test.-abort_windows DARCS_EDITOR=echo export DARCS_EDITOR