% Copyright (C) 20022004 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; see the file COPYING. If not, write to
% the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
% Boston, MA 021101301, USA.
\subsection{darcs send}
\begin{code}
module Darcs.Commands.Send ( send ) where
import Data.Char ( isAlpha, isDigit, isSpace, toLower )
import System.Exit ( exitWith, ExitCode( ExitSuccess ) )
import System.IO.Error ( ioeGetErrorString )
import System.IO ( hClose )
import Control.Monad ( when, unless )
import Data.Maybe ( isJust, isNothing )
import Autoconf ( have_HTTP )
import Darcs.Commands ( DarcsCommand(..) )
import Darcs.Arguments ( DarcsFlag( EditDescription, LogFile, RmLogFile,
Target, OutputAutoName, Output, Context,
DryRun, Verbose, Quiet, Unified
),
fixUrl, definePatches,
get_cc, get_author, working_repo_dir,
edit_description, logfile, rmlogfile,
sign, get_subject, deps_sel, get_in_reply_to,
match_several, set_default, output_auto_name,
output, cc, subject, target, author, sendmail_cmd,
in_reply_to, remote_repo, network_options,
all_interactive, get_sendmail_cmd,
print_dry_run_message_and_exit,
summary, allow_unrelated_repos,
from_opt, dry_run, send_to_context,
)
import Darcs.Hopefully ( PatchInfoAnd, hopefully, info )
import Darcs.Repository ( PatchSet, Repository,
amInRepository, identifyRepositoryFor, withRepoReadLock, ($-),
read_repo, slurp_recorded, prefsUrl, checkUnrelatedRepos )
import Darcs.Patch ( RepoPatch, description, apply_to_slurpy, invert )
import Darcs.Ordered ( FL(..), RL(..), (:>)(..), (:\/:)(..), unsafeUnRL,
mapRL_RL, mapFL, mapRL, reverseRL, mapFL_FL, lengthFL, nullFL )
import Darcs.Patch.Bundle ( make_bundle, scan_context )
import Darcs.Patch.Info ( just_name )
import Darcs.Repository.Prefs ( defaultrepo, set_defaultrepo, get_preflist )
import Darcs.External ( signString, sendEmailDoc, fetchFilePS, Cachable(..), generateEmail )
import ByteStringUtils ( mmapFilePS )
import qualified Data.ByteString.Char8 as BC (unpack)
import Darcs.Lock ( withOpenTemp, writeDocBinFile, readDocBinFile, world_readable_temp, removeFileMayNotExist )
import Darcs.SelectChanges ( with_selected_changes )
import Darcs.Patch.Depends ( get_common_and_uncommon )
import Darcs.Utils ( askUser, catchall, edit_file, formatPath )
import Progress ( debugMessage )
import Darcs.Email ( make_email )
import Printer ( Doc, vsep, vcat, text, ($$), putDocLn, putDoc )
import Darcs.RepoPath ( toFilePath, AbsolutePath, AbsolutePathOrStd,
getCurrentDirectory, makeAbsoluteOrStd, useAbsoluteOrStd )
import HTTP ( postUrl )
#include "impossible.h"
send_description :: String
send_description =
"Send by email a bundle of one or more patches."
\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 by email, although you may save it to a file.\n"
\end{code}
Do not confuse the \verb!--author! options with the return address
that \verb!darcs send! will set for your patch bundle.
For example, if you have two email addresses A and B:
\begin{description}
\item If you use
\verb!--author A! but your machine is configured to send mail from
address B by default, then the return address on your message will be B.
\item If you use \verb!--from A! and your mail client supports setting the
From: address arbitrarily (some nonUnixlike mail clients, especially,
may not support this), then the return address will be A; if it does
not support this, then the return address will be B.
\item If you supply neither \verb!--from! nor \verb!--author!, then the return
address will be B.
\end{description}
In addition, unless you specify the sendmail command with
\verb!--sendmailcommand!, darcs sends email using the default email
command on your computer. This default command is determined by the
\verb!configure! script. Thus, on some nonUnixlike OSes,
\verb!--from! is likely to not work at all.
\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 = amInRepository,
command_get_arg_possibilities = get_preflist "repos",
command_argdefaults = defaultrepo,
command_advanced_options = [logfile, rmlogfile,
remote_repo,
send_to_context] ++
network_options,
command_basic_options = [match_several, deps_sel,
all_interactive,
from_opt, author,
target,cc,subject, in_reply_to,
output,output_auto_name,sign]
++dry_run++[summary,
edit_description,
set_default, working_repo_dir,
sendmail_cmd,
allow_unrelated_repos]}
send_cmd :: [DarcsFlag] -> [String] -> IO ()
send_cmd input_opts [""] = send_cmd input_opts []
send_cmd input_opts [unfixedrepodir] = withRepoReadLock input_opts $- \repository -> do
context_ps <- the_context input_opts
case context_ps of
Just them -> send_to_them repository input_opts [] "CONTEXT" them
Nothing -> do
repodir <- fixUrl input_opts unfixedrepodir
here <- getCurrentDirectory
when (repodir == toFilePath here) $
fail ("Can't send to current repository! Did you mean send -"++"-context?")
repo <- identifyRepositoryFor repository repodir
them <- read_repo repo
old_default <- get_preflist "defaultrepo"
set_defaultrepo repodir input_opts
when (old_default == [repodir] && not (Quiet `elem` input_opts)) $
putStrLn $ "Creating patch to "++formatPath repodir++"..."
wtds <- decide_on_behavior input_opts repo
send_to_them repository input_opts wtds repodir them
where the_context [] = return Nothing
the_context (Context foo:_)
= (Just . scan_context )`fmap` mmapFilePS (toFilePath foo)
the_context (_:fs) = the_context fs
send_cmd _ _ = impossible
send_to_them :: RepoPatch p => Repository p -> [DarcsFlag] -> [WhatToDo] -> String -> PatchSet p -> IO ()
send_to_them repo opts wtds their_name them = do
let am_verbose = Verbose `elem` opts
am_quiet = Quiet `elem` opts
putVerbose s = when am_verbose $ putDocLn s
putInfo s = when (not am_quiet) $ putStrLn s
patch_desc p = just_name $ info p
make_fname tbs = patch_filename $ patch_desc $ headFL tbs
headFL (x:>:_) = x
headFL _ = impossible
us <- read_repo repo
case get_common_and_uncommon (us, them) of
(common, us' :\/: _) -> do
checkUnrelatedRepos opts common us them
case us' of
NilRL:<:NilRL -> do putInfo "No recorded local changes to send!"
exitWith ExitSuccess
_ -> putVerbose $ text "We have the following patches to send:"
$$ (vcat $ mapRL description $ head $ unsafeUnRL us')
s <- slurp_recorded repo
let our_ps = reverseRL $ head $ unsafeUnRL us'
with_selected_changes "send" opts s our_ps $
\ (to_be_sent :> _) -> do
print_dry_run_message_and_exit "send" opts to_be_sent
when (nullFL to_be_sent) $ do
putInfo "You don't want to send any patches, and that's fine with me!"
exitWith ExitSuccess
definePatches to_be_sent
bundle <- signString opts $ make_bundle (Unified:opts)
(fromJust $ apply_to_slurpy
(invert $
mapRL_RL hopefully $ head $ unsafeUnRL us') s)
common (mapFL_FL hopefully to_be_sent)
let outname = get_output opts (make_fname to_be_sent)
case outname of
Just fname -> do (d,f) <- get_description opts to_be_sent
let putabs a = do writeDocBinFile a (d $$ bundle)
putStrLn $ "Wrote patch to " ++ toFilePath a ++ "."
putstd = putDoc (d $$ bundle)
useAbsoluteOrStd putabs putstd fname
cleanup f
Nothing ->
let
auto_subject (p:>:NilFL) = "darcs patch: " ++ trim (patch_desc p) 57
auto_subject (p:>:ps) = "darcs patch: " ++ trim (patch_desc p) 43 ++
" (and " ++ show (lengthFL ps) ++ " more)"
auto_subject _ = error "Tried to get a name from empty patch list."
trim st n = if length st <= n then st
else take (n3) st ++ "..."
in do
thetargets <- get_targets wtds
from <- get_author opts
let thesubject = case get_subject opts of
Nothing -> auto_subject to_be_sent
Just subj -> subj
(mailcontents, mailfile) <- get_description opts to_be_sent
let body = make_email their_name
(maybe [] (\x -> [("In-Reply-To", x), ("References", x)]) . get_in_reply_to $ opts)
(Just mailcontents)
bundle
(Just $ make_fname to_be_sent)
contentAndBundle = Just (mailcontents, bundle)
sendmail = do
sm_cmd <- get_sendmail_cmd opts
(sendEmailDoc from (lt [t | SendMail t <- thetargets]) (thesubject) (get_cc opts)
sm_cmd contentAndBundle body >>
putInfo ("Successfully sent patch bundle to: "
++ lt [ t | SendMail t <- thetargets ]
++ ccs (get_cc opts) ++"."))
`catch` \e -> let msg = "Email body left in " in
do when (isJust mailfile) $
putStrLn $ msg++(fromJust mailfile)++"."
fail $ ioeGetErrorString e
ccs [] = []
ccs cs = " and cc'ed " ++ cs
when (null [ p | Post p <- thetargets]) sendmail
nbody <- withOpenTemp $ \ (fh,fn) -> do
generateEmail fh from (lt [t | SendMail t <- thetargets]) thesubject (get_cc opts) body
hClose fh
mmapFilePS fn
forM_ [ p | Post p <- thetargets]
(\url -> do
putInfo $ "Posting patch to " ++ url
postUrl url (BC.unpack nbody) "message/rfc822")
`catch` const sendmail
cleanup mailfile
where cleanup (Just mailfile) = when (isNothing (get_fileopt opts) || (RmLogFile `elem` opts)) $
removeFileMayNotExist mailfile
cleanup Nothing = return ()
lt [t] = t
lt [t,""] = t
lt (t:ts) = t++" , "++lt ts
lt [] = ""
safeFileChar :: Char -> Char
safeFileChar c | isAlpha c = toLower c
| isDigit c = c
| isSpace c = '-'
safeFileChar _ = '_'
patch_filename :: String -> String
patch_filename the_summary = name ++ ".dpatch"
where name = map safeFileChar the_summary
\end{code}
\begin{options}
\end{options}
The \verb!--output!, \verb!--outputautoname!, 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
specify \verb!--outputautoname!, the patch bundle is saved to a file with an
automatically generated name. If you give one or more \verb!--to! arguments,
the bundle of patches is sent to those locations. The locations may either be email
addresses or urls that the patch should be submitted to via HTTP.
If you don't provide any of these options, 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 \texttt{\_darcs/prefs/post} exists in the target repository, darcs will
upload to the URL contained in that file, which may either be a
\texttt{mailto:} URL, or an \texttt{http://} URL. In the latter case, the
patch is posted to that URL.
If there is no email address associated with the repository, darcs will
prompt you for an email address.
\begin{options}
--subject
\end{options}
Use the \verb!--subject! flag to set the subject of the email to be sent.
If you don't provide a subject on the command line, darcs will make one up
based on names of the patches in the patch bundle.
\begin{options}
--in-reply-to
\end{options}
Use the \verb!--inreplyto! flag to set the InReplyTo and References headers
of the email to be sent. By default no additional headers are included so email
will not be treated as reply by mail readers.
\begin{code}
forM_ :: (Monad m) => [a] -> (a -> m b) -> m ()
forM_ = (flip mapM_)
data WhatToDo
= Post String
| SendMail String
decide_on_behavior :: RepoPatch p => [DarcsFlag] -> Repository p -> IO [WhatToDo]
decide_on_behavior opts the_remote_repo =
case the_targets of
[] ->
if isJust $ get_output opts ""
then return []
else
do wtds <- check_post
unless (null wtds) $ announce_recipients wtds
return wtds
ts -> do announce_recipients ts
return ts
where the_targets = collect_targets opts
check_post | have_HTTP =
do p <- ((readPost . BC.unpack) `fmap`
fetchFilePS (prefsUrl the_remote_repo++"/post")
(MaxAge 600)) `catchall` return []
emails <- who_to_email
return (p++emails)
| otherwise = who_to_email
who_to_email =
do email <- (BC.unpack `fmap`
fetchFilePS (prefsUrl the_remote_repo++"/email")
(MaxAge 600))
`catchall` return ""
if '@' `elem` email then return . map SendMail $ lines email
else return []
readPost p = map pp (lines p) where
pp ('m':'a':'i':'l':'t':'o':':':s) = SendMail s
pp s = Post s
putInfoLn s = unless (Quiet `elem` opts) $ putStrLn s
announce_recipients emails =
let pn (SendMail s) = s
pn (Post p) = p
in if DryRun `elem` opts
then putInfoLn $ "Patch bundle would be sent to: "++unwords (map pn emails)
else when (null the_targets) $
putInfoLn $ "Patch bundle will be sent to: "++unwords (map pn emails)
get_output :: [DarcsFlag] -> FilePath -> Maybe AbsolutePathOrStd
get_output (Output a:_) _ = return a
get_output (OutputAutoName a:_) f = return $ makeAbsoluteOrStd a f
get_output (_:flags) f = get_output flags f
get_output [] _ = Nothing
get_targets :: [WhatToDo] -> IO [WhatToDo]
get_targets [] = do fmap ((:[]) . SendMail) $ askUser "What is the target email address? "
get_targets wtds = return wtds
collect_targets :: [DarcsFlag] -> [WhatToDo]
collect_targets flags = [ f t | Target t <- flags ] where
f url@('h':'t':'t':'p':':':_) = Post url
f em = SendMail em
\end{code}
\begin{options}
\end{options}
The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--nodeps!
options can be used to select which patches to send, as described in
subsection~\ref{selecting}.
\begin{options}
--edit-description
\end{options}
If you want to include a description or explanation along with the bundle
of patches, you need to specify the \verb!--editdescription! flag, which
will cause darcs to open up an editor with which you can compose a message
to go along with your patches.
\begin{options}
--sendmail-command
\end{options}
If you want to use a command different from the default one for sending email,
you need to specify a command line with the \verb!--sendmailcommand! option. The
command line can contain some format specifiers which are replaced by the actual
values. Accepted format specifiers are \verb!%s! for subject, \verb!%t! for to,
\verb!%c! for cc, \verb!%b! for the body of the mail, \verb!%f! for from, \verb!%a!
for the patch bundle and the same specifiers in uppercase for the URLencoded values.
Additionally you can add \verb!%<! to the end of the command line if the command
expects the complete email message on standard input. E.g.\ the command lines for evolution
and msmtp look like this:
\begin{verbatim}
evolution "mailto:%T?subject=%S&attach=%A&cc=%C&body=%B"
msmtp t %<
\end{verbatim}
\begin{code}
get_description :: RepoPatch p => [DarcsFlag] -> FL (PatchInfoAnd p) -> IO (Doc, Maybe String)
get_description opts patches =
case get_filename of
Just f -> do file <- f
when (EditDescription `elem` opts) $ do
when (isNothing $ get_fileopt opts) $
writeDocBinFile file patchdesc
debugMessage $ "About to edit file " ++ file
edit_file file
return ()
doc <- readDocBinFile file
return (doc, Just file)
Nothing -> return (patchdesc, Nothing)
where patchdesc = vsep $ mapFL description patches
get_filename = case get_fileopt opts of
Just f -> Just $ return $ toFilePath f
Nothing -> if EditDescription `elem` opts
then Just tempfile
else Nothing
tempfile = world_readable_temp "darcs-temp-mail"
get_fileopt :: [DarcsFlag] -> Maybe AbsolutePath
get_fileopt (LogFile f:_) = Just f
get_fileopt (_:flags) = get_fileopt flags
get_fileopt [] = Nothing
\end{code}