% Copyright (C) 2002-2004 David Roundy % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2, or (at your option) % any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software Foundation, % Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. \section{darcs send} \begin{code} module Send ( send ) where import IO ( stdout, hFlush ) import System ( exitWith, ExitCode( ExitSuccess ) ) import Monad ( when, unless, liftM ) import List ( elem ) import Maybe ( catMaybes ) import DarcsCommands ( DarcsCommand(..) ) import DarcsArguments ( DarcsFlag( EditDescription, Target, Output, Context, Verbose, Quiet, DryRun ), edit_file, get_cc, get_author, working_repo_dir, edit_description, sign, match_several, set_default, output, cc, target, author, all_gui_interactive, any_verbosity, unified, from_opt, dry_run, send_to_context, ) import Repository ( PatchSet, read_repo, slurp_recorded, am_in_repo, is_repo ) import Patch ( Patch, patch_description, patch2patchinfo, apply_to_slurpy, invert, join_patches, ) import PatchInfo ( human_friendly ) import RepoPrefs ( defaultrepo, set_defaultrepo, get_preflist ) import External ( signString, sendEmail, fetchFilePS, Cachable(..) ) import FastPackedString ( unpackPS, mmapFilePS ) import Lock ( writeBinFile, withLock, readBinFile ) import SelectChanges ( with_selected_changes ) import Depends ( get_common_and_uncommon ) import PatchBundle ( make_bundle, scan_context ) import DarcsUtils ( catchall ) #include "impossible.h" \end{code} \begin{code} send_description :: String send_description = "Send via email a bundle of one or more patches.\n" \end{code} \options{send} \haskell{send_help} \begin{code} send_help :: String send_help = "Send is used to prepare a bundle of patches that can be applied to a target\n"++ "repository. Send accepts the URL of the repository as an argument. When\n"++ "called without an argument, send will use the most recent repository that\n"++ "was either pushed to, pulled from or sent to. By default, the patch bundle\n"++ "is sent via email, although you may save it to a file.\n" \end{code} \begin{code} send :: DarcsCommand send = DarcsCommand {command_name = "send", command_help = send_help, command_description = send_description, command_extra_args = 1, command_extra_arg_help = ["[REPOSITORY]"], command_command = send_cmd, command_prereq = am_in_repo, command_get_arg_possibilities = get_preflist "repos", command_argdefaults = defaultrepo, command_darcsoptions = [any_verbosity, match_several, all_gui_interactive, from_opt, author, target,cc,output,sign, unified, dry_run, send_to_context, edit_description, set_default, working_repo_dir]} \end{code} \begin{code} send_cmd :: [DarcsFlag] -> [String] -> IO () send_cmd input_opts [repodir] = do context_ps <- the_context input_opts case context_ps of Just them -> send_to_them input_opts "CONTEXT" them Nothing -> do repovalid <- is_repo repodir unless repovalid $ fail $ "Bad repo directory: "++repodir old_default <- defaultrepo [] set_defaultrepo repodir input_opts when (old_default == [repodir] && not (Quiet `elem` input_opts)) $ putStr $ "Creating patch to "++repodir++"...\n" opts <- decide_on_behavior input_opts repodir them <- read_repo repodir send_to_them opts repodir them where the_context [] = return Nothing the_context (Context foo:_) = (Just . scan_context )`liftM` mmapFilePS foo the_context (_:fs) = the_context fs send_cmd _ _ = impossible send_to_them :: [DarcsFlag] -> String -> PatchSet -> IO () send_to_them opts their_name them = let am_verbose = Verbose `elem` opts am_quiet = Quiet `elem` opts putVerbose s = when am_verbose $ putStr s putInfo s = when (not am_quiet) $ putStr s in withLock "./_darcs/lock" $ do us <- read_repo "." case get_common_and_uncommon (us, them) of (common, us', _) -> do putVerbose $ "We have the following patches to send:\n" ++ (unlines $ map (human_friendly.fst) $ head us') when (us' == [[]]) $ do putInfo "No recorded local changes to send!\n" exitWith ExitSuccess s <- slurp_recorded "." with_selected_changes "send" opts s (map (fromJust.snd) $ reverse $ head us') $ \ (_,to_be_sent) -> do when (DryRun `elem` opts) $ do putStr $ "Would send the following changes:\n"++ (unlines $ map (human_friendly.fromJust.patch2patchinfo) to_be_sent) putStr "Making no changes: this is a dry run.\n" exitWith ExitSuccess when (to_be_sent == []) $ do putInfo "You don't want to send any patches, and that's fine with me!\n" exitWith ExitSuccess wantfile <- wants_output opts from <- get_author opts bundle <- signString opts $ make_bundle opts (fromJust $ apply_to_slurpy (invert $ join_patches $ reverse $ map (fromJust.snd) $ head us') s) common to_be_sent if wantfile then do fname <- get_output opts writeBinFile fname bundle else do thetargets <- get_targets opts mailcontents <- get_description opts to_be_sent sendEmail from (lt thetargets) "darcs patch" (get_cc opts) $ make_email their_name mailcontents bundle "aaack" putInfo $ "Successfully sent patch bundle to "++lt thetargets++".\n" where lt [t] = t lt [t,""] = t lt (t:ts) = t++" , "++lt ts lt [] = "" make_email :: String -> String -> String -> String -> String make_email repodir contents bundle boundary = "DarcsURL: "++repodir++"\n"++ "Content-Type: multipart/mixed; boundary=\""++boundary++"\"\n"++ "\n--"++boundary++"\n"++ "Content-Type: text/plain\n\n"++ contents++"\n"++ "\n--"++boundary++"\n"++ "Content-Type: text/x-darcs-patch\n"++ "Content-Description: A darcs patch for your repository!\n\n"++ bundle ++ "\n--"++boundary++"\n"++ "\n.\n\n" \end{code} If you want to create a patches having context, you can use the \verb!--unified! option, which create output vaguely reminiscent of ``diff~-u''. The \verb!--output! and \verb!--to! flags determine what darcs does with the patch bundle after creating it. If you provide an \verb!--output! argument, the patch bundle is saved to that file. If you give one or more \verb!--to! arguments, the bundle of patches is emailed to those addresses. If you don't provide either a \verb!--output! or a \verb!--to! flag, darcs will look at the contents of the \verb!_darcs/prefs/email! file in the target repository (if it exists), and send the patch by email to that address. In this case, you may use the \verb!--cc! option to specify additional recipients without overriding the default repository email address. If there is no email address associated with the repository, darcs will prompt you for an email address. \begin{code} decide_on_behavior :: [DarcsFlag] -> String -> IO [DarcsFlag] decide_on_behavior opts remote_repo = if want_to opts then return opts else do wantfile <- wants_output opts if wantfile then return opts else do email_defaults <- who_to_email case email_defaults of [] -> return opts emails -> do putInfoLn $ "Sending via email to "++unwords emails return $ map Target emails ++ opts where want_to [] = False want_to (Target _:_) = True want_to (_:os) = want_to os who_to_email = do email <- (unpackPS `liftM` fetchFilePS (remote_repo++"/_darcs/prefs/email") (MaxAge 600)) `catchall` return "" if '@' `elem` email then return $ lines email else return [] putInfoLn s = unless (Quiet `elem` opts) $ putStrLn s \end{code} \begin{code} wants_output :: [DarcsFlag] -> IO Bool wants_output (Output _:_) = return True wants_output (_:flags) = wants_output flags wants_output [] = return False get_output :: [DarcsFlag] -> IO String get_output (Output a:_) = return a get_output (_:flags) = get_output flags get_output [] = bug "in Send: called get_output when wants_output is false." \end{code} \begin{code} get_targets :: [DarcsFlag] -> IO [String] get_targets flags = case catMaybes $ map towhom flags of [] -> do putStr "What is the target email address? " hFlush stdout liftM (:[]) getLine ts -> return $ ts where towhom (Target t) = Just t towhom _ = Nothing \end{code} The \verb!--patches!, \verb!--matches!, and \verb!--tags! options can be used to select which patches to send, as described in section~\ref{selecting}. darcs will silently send along any other patches upon which the selected patches depend. If you want to include a description or explanation along with the bundle of patches, you need to specify the \verb!--edit-description! flag, which will cause darcs to open up an editor with which you can compose an email to go along with your patches. \begin{code} get_description :: [DarcsFlag] -> [Patch] -> IO String get_description opts patches = if EditDescription `elem` opts then do writeFile ".darcs-temp-mail" patchdesc edit_file ".darcs-temp-mail" readBinFile ".darcs-temp-mail" else return patchdesc where patchdesc = concatMap patch_description patches \end{code}