1 %  Copyright (C) 2003 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{dist}
   19 \begin{code}
   20 module Darcs.Commands.Dist ( dist ) where
   21 import System.Directory ( setCurrentDirectory )
   22 import Workaround ( getCurrentDirectory )
   23 import System.Exit ( ExitCode(..), exitWith )
   24 import System.Cmd ( system )
   25 import System.FilePath.Posix ( takeFileName, (</>) )
   26 import Data.Char ( isAlphaNum )
   27 import Control.Monad ( when )
   28 
   29 import Darcs.Commands ( DarcsCommand(DarcsCommand, command_name, command_help,
   30                         command_description, command_extra_args,
   31                         command_extra_arg_help, command_command,
   32                         command_prereq, command_get_arg_possibilities,
   33                         command_argdefaults,
   34                         command_advanced_options, command_basic_options),
   35                         nodefaults )
   36 import Darcs.Arguments ( DarcsFlag(Verbose, DistName), distname_option,
   37                          working_repo_dir, match_one, store_in_memory,
   38                          fixSubPaths )
   39 import Darcs.Match ( get_nonrange_match, have_nonrange_match )
   40 import Darcs.Repository ( amInRepository, withRepoReadLock, ($-), --withRecorded,
   41                           createPartialsPristineDirectoryTree )
   42 import Darcs.Repository.Prefs ( get_prefval )
   43 import Darcs.Lock ( withTemp, withTempDir, readBinFile )
   44 import Darcs.RepoPath ( AbsolutePath, toFilePath )
   45 import Darcs.Utils ( withCurrentDirectory )
   46 import Exec ( exec, Redirect(..) )
   47 
   48 dist_description :: String
   49 dist_description = "Create a distribution tarball."
   50 
   51 dist_help :: String
   52 dist_help =
   53  "The `darcs dist' command creates a compressed archive (a `tarball') in\n" ++
   54  "the repository's root directory, containing the recorded state of the\n" ++
   55  "working tree (unrecorded changes and the _darcs directory are\n" ++
   56  "excluded).\n" ++
   57  "\n" ++
   58  "If a predist command is set (see `darcs setpref'), that command will\n" ++
   59  "be run on the tarball contents prior to archiving.  For example,\n" ++
   60  "autotools projects would set it to `autoconf && automake'.\n" ++
   61  "\n" ++
   62  "By default, the tarball (and the top-level directory within the\n" ++
   63  "tarball) has the same name as the repository, but this can be\n" ++
   64  "overridden with the --dist-name option.\n"
   65 
   66  -- FIXME: this is tedious and ugly.
   67  {-
   68  ++ "\n" ++
   69  "Suppose you use a version numbering scheme `major.minor.patch', and\n" ++
   70  "you tag each release `major.minor'.  You can then calculate the\n" ++
   71  "version number by taking the newest tag and appending a dot and the\n" ++
   72  "number of patches since that tag.  If you use the directory name as\n" ++
   73  "the project name, you can make tarballs of the form name-version.tgz\n" ++
   74  "using the following shell script:\n" ++
   75  "\n" ++
   76  "  major_minor=$(darcs show tags | head -1) &&\n" ++
   77  "  patch_level=$(($(darcs changes --count --from-tag .) - 1)) &&\n" ++
   78  "  version=$major_minor.$patch_level &&\n" ++
   79  "  project=${PWD##*/} &&\n" ++
   80  "  darcs dist --dist-name \"$project\"-\"$version\".tar.gz\n"
   81  -}
   82 
   83 dist :: DarcsCommand
   84 dist = DarcsCommand {command_name = "dist",
   85                      command_help = dist_help,
   86                      command_description = dist_description,
   87                      command_extra_args = 0,
   88                      command_extra_arg_help = [],
   89                      command_command = dist_cmd,
   90                      command_prereq = amInRepository,
   91                      command_get_arg_possibilities = return [],
   92                      command_argdefaults = nodefaults,
   93                      command_advanced_options = [],
   94                      command_basic_options = [distname_option,
   95                                               working_repo_dir,
   96                                               match_one,
   97                                               store_in_memory]}
   98 
   99 dist_cmd :: [DarcsFlag] -> [String] -> IO ()
  100 dist_cmd opts args = withRepoReadLock opts $- \repository -> do
  101   distname <- get_dist_name opts
  102   verb <- return $ Verbose `elem` opts
  103   predist <- get_prefval "predist"
  104   formerdir <- getCurrentDirectory
  105   path_list <- if null args
  106                then return [""]
  107                else map toFilePath `fmap` fixSubPaths opts args
  108   resultfile <- return (formerdir</>distname++".tar.gz")
  109   withTemp $ \tarfile ->
  110     withTempDir "darcsdist" $ \tempdir -> do
  111       setCurrentDirectory (formerdir)
  112       withTempDir (toFilePath tempdir </> takeFileName distname) $ \ddir -> do
  113         if have_nonrange_match opts
  114           then withCurrentDirectory ddir $ get_nonrange_match repository opts
  115           else createPartialsPristineDirectoryTree repository path_list (toFilePath ddir)
  116         ec <- case predist of Nothing -> return ExitSuccess
  117                               Just pd -> system pd
  118         if (ec == ExitSuccess) then do_dist verb tarfile tempdir ddir resultfile
  119             else
  120                 do
  121                 putStrLn "Dist aborted due to predist failure"
  122                 exitWith ec
  123 
  124 -- | This function performs the actual distribution action itself.
  125 -- NB - it does /not/ perform the pre-dist, that should already
  126 -- have completed successfully before this is invoked.
  127 do_dist :: Bool -> FilePath -> AbsolutePath -> AbsolutePath -> FilePath -> IO ()
  128 do_dist verb tarfile tempdir ddir resultfile = do
  129   setCurrentDirectory (toFilePath tempdir)
  130   exec "tar" ["-cf", "-", safename $ takeFileName $ toFilePath ddir]
  131              (Null, File tarfile, AsIs)
  132   when verb $ withTemp $ \tar_listing -> do
  133                 exec "tar" ["-tf", "-"]
  134                      (File tarfile, File tar_listing, Stdout)
  135                 to <- readBinFile tar_listing
  136                 putStr to
  137   exec "gzip" ["-c"]
  138        (File tarfile, File resultfile, AsIs)
  139   putStrLn $ "Created dist as "++resultfile
  140   where
  141     safename n@(c:_) | isAlphaNum c  = n
  142     safename n = "./" ++ n
  143 
  144 guess_repo_name :: IO String
  145 guess_repo_name = do
  146   pwd <- getCurrentDirectory
  147   if '/' `elem` pwd
  148      then return $ reverse $ takeWhile (/='/') $ reverse pwd
  149      else return "cantguessreponame"
  150 
  151 get_dist_name :: [DarcsFlag] -> IO String
  152 get_dist_name (DistName dn:_) = return dn
  153 get_dist_name (_:fs) = get_dist_name fs
  154 get_dist_name _ = guess_repo_name
  155 \end{code}
  156