git-annex/Build/NullSoftInstaller.hs

199 lines
6.9 KiB
Haskell
Raw Normal View History

2013-05-14 22:01:45 +00:00
{- Generates a NullSoft installer program for git-annex on Windows.
2013-05-14 21:15:02 +00:00
-
- This uses the Haskell nsis package to generate a .nsi file,
- which is then used to produce git-annex-installer.exe
2013-05-14 21:15:02 +00:00
-
- The installer includes git-annex, and utilities it uses, with the
- exception of git and some utilities that are bundled with git.
- The user needs to install git separately, and the installer checks
- for that.
-
- To build the installer, git-annex should already be built to
- ./git-annex.exe and the necessary utility programs (rsync and wget)
- already installed in PATH from msys32.
2013-05-14 21:15:02 +00:00
-
- Copyright 2013-2015 Joey Hess <id@joeyh.name>
2013-05-14 21:15:02 +00:00
-
- Licensed under the GNU GPL version 3 or higher.
2013-05-14 22:01:45 +00:00
-}
2015-09-01 22:02:37 +00:00
{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
2013-05-14 22:01:45 +00:00
import Development.NSIS
2013-05-15 00:59:14 +00:00
import System.FilePath
import Control.Monad
import Control.Applicative
2013-05-15 00:59:14 +00:00
import Data.String
import Data.Maybe
import Data.Char
2015-04-21 20:38:49 +00:00
import Data.List (nub, isPrefixOf)
2013-05-14 22:01:45 +00:00
2018-01-10 17:23:10 +00:00
import Utility.Tmp.Dir
import Utility.Path
2013-05-15 00:59:14 +00:00
import Utility.CopyFile
import Utility.SafeCommand
import Utility.Process
import Utility.Exception
import Utility.Directory
2013-05-15 00:59:14 +00:00
import Build.BundledPrograms
main = do
withTmpDir "nsis-build" $ \tmpdir -> do
2013-05-17 00:41:20 +00:00
let gitannex = tmpdir </> gitannexprogram
mustSucceed "ln" [File "git-annex.exe", File gitannex]
2013-05-17 00:41:20 +00:00
let license = tmpdir </> licensefile
2013-05-17 00:04:05 +00:00
mustSucceed "sh" [Param "-c", Param $ "zcat standalone/licences.gz > '" ++ license ++ "'"]
webappscript <- vbsLauncher tmpdir "git-annex-webapp" "git annex webapp"
autostartscript <- vbsLauncher tmpdir "git-annex-autostart" "git annex assistant --autostart"
let htmlhelp = tmpdir </> "git-annex.html"
writeFile htmlhelp htmlHelpText
let gitannexcmd = tmpdir </> "git-annex.cmd"
writeFile gitannexcmd "git annex %*"
writeFile nsifile $ makeInstaller
gitannex gitannexcmd license htmlhelp winPrograms
[ webappscript, autostartscript ]
2013-05-17 18:06:47 +00:00
mustSucceed "makensis" [File nsifile]
2013-05-15 00:59:14 +00:00
removeFile nsifile -- left behind if makensis fails
where
nsifile = "git-annex.nsi"
mustSucceed cmd params = do
r <- boolSystem cmd params
case r of
True -> return ()
2013-05-17 00:04:05 +00:00
False -> error $ cmd ++ " failed"
2013-05-15 00:59:14 +00:00
{- Generates a .vbs launcher which runs a command without any visible DOS
- box. It expects to be passed the directory where git-annex is installed. -}
vbsLauncher :: FilePath -> String -> String -> IO String
vbsLauncher tmpdir basename cmd = do
let f = tmpdir </> basename ++ ".vbs"
writeFile f $ unlines
[ "Set objshell=CreateObject(\"Wscript.Shell\")"
, "objShell.CurrentDirectory = Wscript.Arguments.item(0)"
, "objShell.Run(\"" ++ cmd ++ "\"), 0, False"
]
return f
2013-05-17 00:41:20 +00:00
gitannexprogram :: FilePath
gitannexprogram = "git-annex.exe"
licensefile :: FilePath
licensefile = "git-annex-licenses.txt"
2013-05-15 00:59:14 +00:00
installer :: FilePath
installer = "git-annex-installer.exe"
2013-05-17 00:41:20 +00:00
uninstaller :: FilePath
uninstaller = "git-annex-uninstall.exe"
2013-05-15 00:59:14 +00:00
gitInstallDir :: Exp FilePath
gitInstallDir = fromString "$PROGRAMFILES\\Git"
2013-05-15 00:59:14 +00:00
-- This intentionally has a different name than git-annex or
-- git-annex-webapp, since it is itself treated as an executable file.
-- Also, on XP, the filename is displayed, not the description.
2013-12-10 04:37:06 +00:00
startMenuItem :: Exp FilePath
startMenuItem = "$SMPROGRAMS/Git Annex (Webapp).lnk"
oldStartMenuItem :: Exp FilePath
oldStartMenuItem = "$SMPROGRAMS/git-annex.lnk"
2013-12-10 04:37:06 +00:00
autoStartItem :: Exp FilePath
autoStartItem = "$SMSTARTUP/git-annex-autostart.lnk"
2013-05-15 00:59:14 +00:00
needGit :: Exp String
needGit = strConcat
[ fromString "You need git installed to use git-annex. Looking at "
, gitInstallDir
, fromString " , it seems to not be installed, "
, fromString "or may be installed in another location. "
, fromString "You can install git from http:////git-scm.com//"
2013-05-15 00:59:14 +00:00
]
makeInstaller :: FilePath -> FilePath -> FilePath -> FilePath -> [FilePath] -> [FilePath] -> String
makeInstaller gitannex gitannexcmd license htmlhelp extrabins launchers = nsis $ do
2013-05-14 22:01:45 +00:00
name "git-annex"
2013-05-15 00:59:14 +00:00
outFile $ str installer
{- Installing into the same directory as git avoids needing to modify
- path myself, since the git installer already does it. -}
2013-05-15 00:59:14 +00:00
installDir gitInstallDir
2013-12-10 04:32:08 +00:00
requestExecutionLevel Admin
2013-05-15 00:59:14 +00:00
iff (fileExists gitInstallDir)
(return ())
(alert needGit)
2013-05-14 22:01:45 +00:00
-- Pages to display
page Directory -- Pick where to install
2013-05-17 00:32:59 +00:00
page (License license)
2013-05-14 22:01:45 +00:00
page InstFiles -- Give a progress bar while installing
2013-12-10 04:13:15 +00:00
-- Start menu shortcut
2013-12-10 04:17:20 +00:00
Development.NSIS.createDirectory "$SMPROGRAMS"
2013-12-10 04:37:06 +00:00
createShortcut startMenuItem
[ Target "wscript.exe"
, Parameters "\"$INSTDIR/cmd/git-annex-webapp.vbs\" \"$INSTDIR/cmd\""
2014-06-17 18:28:44 +00:00
, StartOptions "SW_SHOWNORMAL"
, IconFile "$INSTDIR/usr/bin/git-annex.exe"
2013-12-10 04:13:15 +00:00
, IconIndex 2
, Description "Git Annex (Webapp)"
2013-12-10 04:13:15 +00:00
]
delete [RebootOK] $ oldStartMenuItem
createShortcut autoStartItem
[ Target "wscript.exe"
, Parameters "\"$INSTDIR/cmd/git-annex-autostart.vbs\" \"$INSTDIR/cmd\""
2014-06-17 18:28:44 +00:00
, StartOptions "SW_SHOWNORMAL"
, IconFile "$INSTDIR/usr/bin/git-annex.exe"
, IconIndex 2
, Description "git-annex autostart"
]
section "cmd" [] $ do
-- Remove old files no longer installed in the cmd
-- directory.
removefilesFrom "$INSTDIR/cmd" (gitannex:extrabins)
-- Install everything to the same location git puts its
-- bins. This makes "git annex" work in the git bash
-- shell, since git expects to find the git-annex binary
-- there.
setOutPath "$INSTDIR\\usr\\bin"
mapM_ addfile (gitannex:extrabins)
-- This little wrapper is installed in the cmd directory,
-- so that "git-annex" works (as well as "git annex"),
-- when only that directory is in PATH (ie, in a ms-dos
-- prompt window).
setOutPath "$INSTDIR\\cmd"
addfile gitannexcmd
section "meta" [] $ do
-- git opens this file when git annex --help is run.
-- (Program Files/Git/mingw32/share/doc/git-doc/git-annex.html)
setOutPath "$INSTDIR\\mingw32\\share\\doc\\git-doc"
addfile htmlhelp
setOutPath "$INSTDIR"
2013-05-17 00:00:31 +00:00
addfile license
setOutPath "$INSTDIR\\cmd"
mapM_ addfile launchers
2013-05-17 00:41:20 +00:00
writeUninstaller $ str uninstaller
2013-12-10 04:37:06 +00:00
uninstall $ do
2013-12-10 04:37:58 +00:00
delete [RebootOK] $ startMenuItem
delete [RebootOK] $ autoStartItem
removefilesFrom "$INSTDIR/usr/bin" (gitannex:extrabins)
removefilesFrom "$INSTDIR/cmd" (gitannexcmd:launchers)
removefilesFrom "$INSTDIR\\mingw32\\share\\doc\\git-doc" [htmlhelp]
removefilesFrom "$INSTDIR" [license, uninstaller]
2013-05-14 22:01:45 +00:00
where
2013-05-15 00:59:14 +00:00
addfile f = file [] (str f)
removefilesFrom d = mapM_ (\f -> delete [RebootOK] $ fromString $ d ++ "/" ++ takeFileName f)
2013-05-15 00:59:14 +00:00
winPrograms :: [FilePath]
winPrograms = map (\p -> p ++ ".exe") bundledPrograms
2013-05-15 00:59:14 +00:00
2015-01-29 17:51:30 +00:00
htmlHelpText :: String
htmlHelpText = unlines
[ "<html>"
, "<title>git-annex help</title>"
, "<body>"
, "For help on git-annex, run \"git annex help\", or"
, "<a href=\"https://git-annex.branchable.com/git-annex/\">read the man page</a>."
, "</body>"
, "</html"
]