1 % Copyright (C) 2002-2004 David Roundy 2 % 3 % This program is free software; you can redistribute it and/or modify 4 % it under the terms of the GNU General Public License as published by 5 % the Free Software Foundation; either version 2, or (at your option) 6 % any later version. 7 % 8 % This program is distributed in the hope that it will be useful, 9 % but WITHOUT ANY WARRANTY; without even the implied warranty of 10 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 % GNU General Public License for more details. 12 % 13 % You should have received a copy of the GNU General Public License 14 % along with this program; see the file COPYING. If not, write to 15 % the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 16 % Boston, MA 02110-1301, USA. 17 18 \darcsCommand{push} 19 \begin{code} 20 {-# OPTIONS_GHC -cpp #-} 21 {-# LANGUAGE CPP #-} 22 23 module Darcs.Commands.Push ( push ) where 24 import System.Exit ( exitWith, ExitCode( ExitSuccess, ExitFailure ) ) 25 import Control.Monad ( when ) 26 import Data.Char ( toUpper ) 27 import Workaround ( getCurrentDirectory ) 28 import Darcs.Commands ( DarcsCommand(..) ) 29 import Darcs.Arguments ( DarcsFlag( DryRun, Verbose, Quiet, Sign, SignAs, NoSign, SignSSL ), 30 definePatches, 31 working_repo_dir, summary, 32 print_dry_run_message_and_exit, 33 applyas, match_several, fixUrl, deps_sel, 34 all_interactive, dry_run, nolinks, 35 remote_repo, network_options, 36 set_default, sign, allow_unrelated_repos 37 ) 38 import Darcs.Hopefully ( hopefully ) 39 import Darcs.Repository ( withRepoReadLock, ($-), identifyRepositoryFor, 40 read_repo, amInRepository, checkUnrelatedRepos ) 41 import Darcs.Patch ( description ) 42 import Darcs.Ordered ( RL(..), (:>)(..), (:\/:)(..), 43 nullFL, reverseRL, mapFL_FL, unsafeUnRL, mapRL, lengthRL ) 44 import Darcs.Repository.Prefs ( defaultrepo, set_defaultrepo, get_preflist ) 45 import Darcs.External ( maybeURLCmd, signString ) 46 import Darcs.URL ( is_url, is_file ) 47 import Darcs.SelectChanges ( with_selected_changes ) 48 import Darcs.Utils ( formatPath ) 49 import Darcs.Patch.Depends ( get_common_and_uncommon ) 50 import Darcs.Patch.Bundle ( make_bundle ) 51 import Printer ( vcat, empty, text, ($$), (<+>), putDocLn, errorDoc ) 52 import Darcs.RemoteApply ( remote_apply, apply_as ) 53 import Darcs.Email ( make_email ) 54 import English (englishNum, Noun(..)) 55 #include "impossible.h" 56 57 push_description :: String 58 push_description = 59 "Copy and apply patches from this repository to another one." 60 61 push_help :: String 62 push_help = 63 "Push is the opposite of pull. Push allows you to copy changes from the\n"++ 64 "current repository into another repository.\n" 65 66 push :: DarcsCommand 67 push = DarcsCommand {command_name = "push", 68 command_help = push_help, 69 command_description = push_description, 70 command_extra_args = 1, 71 command_extra_arg_help = ["[REPOSITORY]"], 72 command_command = push_cmd, 73 command_prereq = amInRepository, 74 command_get_arg_possibilities = get_preflist "repos", 75 command_argdefaults = defaultrepo, 76 command_advanced_options = [applyas, 77 nolinks, 78 remote_repo] ++ 79 network_options, 80 command_basic_options = [match_several, deps_sel, 81 all_interactive, 82 sign]++dry_run++[summary, 83 working_repo_dir, 84 set_default, 85 allow_unrelated_repos]} 86 87 push_cmd :: [DarcsFlag] -> [String] -> IO () 88 push_cmd opts [""] = push_cmd opts [] 89 push_cmd opts [unfixedrepodir] = 90 let am_verbose = Verbose `elem` opts 91 am_quiet = Quiet `elem` opts 92 putVerbose s = when am_verbose $ putDocLn s 93 putInfo s = when (not am_quiet) $ putDocLn s 94 in 95 do 96 repodir <- fixUrl opts unfixedrepodir 97 -- Test to make sure we aren't trying to push to the current repo 98 here <- getCurrentDirectory 99 when (repodir == here) $ 100 fail "Cannot push from repository to itself." 101 -- absolute '.' also taken into account by fix_filepath 102 (bundle,num_to_pull) <- withRepoReadLock opts $- \repository -> do 103 if is_url repodir then do 104 when (apply_as opts /= Nothing) $ 105 let msg = text "Cannot --apply-as when pushing to URLs" in 106 if DryRun `elem` opts 107 then putInfo $ text "NOTE: " <+> msg 108 $$ text "" 109 else errorDoc msg 110 maybeapply <- maybeURLCmd "APPLY" repodir 111 when (maybeapply == Nothing) $ 112 let lprot = takeWhile (/= ':') repodir 113 prot = map toUpper lprot 114 msg = text ("Pushing to "++lprot++" URLs is not supported.\n"++ 115 "You may be able to hack this to work"++ 116 " using DARCS_APPLY_"++prot) in 117 if DryRun `elem` opts 118 then putInfo $ text "NOTE:" <+> msg 119 $$ text "" 120 else errorDoc msg 121 else do 122 when (want_sign opts) $ 123 let msg = text "Signing doesn't make sense for local repositories or when pushing over ssh." 124 in if DryRun `elem` opts 125 then putInfo $ text "NOTE:" <+> msg 126 else errorDoc msg 127 them <- identifyRepositoryFor repository repodir >>= read_repo 128 old_default <- get_preflist "defaultrepo" 129 set_defaultrepo repodir opts 130 when (old_default == [repodir]) $ 131 let pushing = if DryRun `elem` opts then "Would push" else "Pushing" 132 in putInfo $ text $ pushing++" to "++formatPath repodir++"..." 133 us <- read_repo repository 134 case get_common_and_uncommon (us, them) of 135 (common, us' :\/: them') -> do 136 checkUnrelatedRepos opts common us them 137 putVerbose $ text "We have the following patches to push:" 138 $$ (vcat $ mapRL description $ head $ unsafeUnRL us') 139 firstUs <- case us' of 140 NilRL:<:NilRL -> do putInfo $ text "No recorded local changes to push!" 141 exitWith ExitSuccess 142 NilRL -> bug "push_cmd: us' is empty!" 143 (x:<:_) -> return x 144 with_selected_changes "push" opts (reverseRL firstUs) $ 145 \ (to_be_pushed:>_) -> do 146 definePatches to_be_pushed 147 print_dry_run_message_and_exit "push" opts to_be_pushed 148 when (nullFL to_be_pushed) $ do 149 putInfo $ 150 text "You don't want to push any patches, and that's fine with me!" 151 exitWith ExitSuccess 152 let num_to_pull = lengthRL $ head $ unsafeUnRL them' 153 bundle = make_bundle [] 154 (bug "using slurpy in make_bundle called from Push") 155 common (mapFL_FL hopefully to_be_pushed) 156 return (bundle, num_to_pull) 157 sbundle <- signString opts bundle 158 let body = if is_file repodir 159 then sbundle 160 else make_email repodir [] Nothing sbundle Nothing 161 rval <- remote_apply opts repodir body 162 let pull_reminder = 163 if num_to_pull > 0 164 then text $ "(By the way, the remote repository has " ++ show num_to_pull ++ " " 165 ++ englishNum num_to_pull (Noun "patch") " to pull.)" 166 else empty 167 case rval of ExitFailure ec -> do putStrLn $ "Apply failed!" 168 exitWith (ExitFailure ec) 169 ExitSuccess -> putInfo $ text "Push successful." $$ pull_reminder 170 171 push_cmd _ _ = impossible 172 173 want_sign :: [DarcsFlag] -> Bool 174 want_sign opts = case opts of 175 [] -> False 176 Sign:_ -> True 177 (SignAs _):_ -> True 178 (SignSSL _):_ -> True 179 NoSign:_ -> False 180 _:opts' -> want_sign opts' 181 \end{code} 182 183 For obvious reasons, you can only push to repositories to which you have 184 write access. In addition, you can only push to repos that you access 185 either on the local file system or with ssh. In order to apply with ssh, 186 darcs must also be installed on the remote computer. The command invoked 187 to run ssh may be configured by the \verb!DARCS_SSH! environment variable 188 (see subsection~\ref{env:DARCS_SSH}). The command invoked via ssh is always 189 \verb!darcs!, i.e.\ the darcs executable must be in the default path on 190 the remote machine. 191 192 Push works by creating a patch bundle, and then running darcs apply in the 193 target repository using that patch bundle. This means that the default 194 options for \emph{apply} in the \emph{target} repository (such as, for 195 example, \verb!--test!) will affect the behavior of push. This also means 196 that push is somewhat less efficient than pull. 197 198 When you receive an error message such as 199 \begin{verbatim} 200 bash: darcs: command not found 201 \end{verbatim} 202 then this means that the darcs on the remote machine could 203 not be started. Make sure that the darcs executable is called 204 \verb!darcs! and is found in the default path. The default path can 205 be different in interactive and in non-interactive shells. Say 206 \begin{verbatim} 207 ssh login@remote.machine darcs 208 \end{verbatim} 209 to try whether the remote darcs can be found, or 210 \begin{verbatim} 211 ssh login@remote.machine 'echo $PATH' 212 \end{verbatim} 213 (note the single quotes) to check the default path. 214 215 \begin{options} 216 --apply-as 217 \end{options} 218 219 If you give the \verb!--apply-as! flag, darcs will use sudo to apply the 220 changes as a different user. This can be useful if you want to set up a 221 system where several users can modify the same repository, but you don't 222 want to allow them full write access. This isn't secure against skilled 223 malicious attackers, but at least can protect your repository from clumsy, 224 inept or lazy users. 225 226 \begin{options} 227 --matches, --patches, --tags, --no-deps 228 \end{options} 229 230 The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps! 231 options can be used to select which patches to push, as described in 232 subsection~\ref{selecting}. 233 234 When there are conflicts, the behavior of push is determined by the default 235 flags to \verb!apply! in the \emph{target} repository. Most commonly, for 236 pushed-to repositories, you'd like to have \verb!--dont-allow-conflicts! as 237 a default option to apply (by default, it is already the default\ldots). If 238 this is the case, when there are conflicts on push, darcs will fail with an 239 error message. You can then resolve by pulling the conflicting patch, 240 recording a resolution and then pushing the resolution together with the 241 conflicting patch. 242 243 Darcs does not have an explicit way to tell you which patch conflicted, only the 244 file name. You may want to pull all the patches from the remote repository just 245 to be sure. If you don't want to do this in your working directory, 246 you can create another darcs working directory for this purpose. 247 248 If you want, you could set the target repository to use \verb!--allow-conflicts!. 249 In this case conflicting patches will be applied, but the conflicts will 250 not be marked in the working directory. 251 252 If, on the other hand, you have \verb!--mark-conflicts! specified as a 253 default flag for apply in the target repository, when there is a conflict, 254 it will be marked in the working directory of the target repository. In 255 this case, you should resolve the conflict in the target repository itself.