* Creating Windows Installers ============================= This is the user guide for a tool that tries to assist you in creating Microsoft Windows installers. It lets you put together installer builders for your application/library/tool, builders that can then be used to automate the actual rolling up of shippable Windows Installers. The tool uses Haskell to tailor the general installer framework to the needs of your application's installation story. Enough content-free verbiage -- let's get concrete and look at how to author your own installer builders. * Getting started ================= The easiest way to get started is to look at existing installer templates, and try to tailor these to fit; see the templates/ directory. 'bamse' uses Haskell as the specification language for these templates, requiring the user to supply a Haskell module that exports a collection of functions and values that define the characteristics of an installer builder. Using an existing programming language for this rather than invent some custom input format/schema to specify the behaviour and contents of an installer has some merit. It is still an open issue whether or not the power of a programming language is required though, and something we hope to better understand by specifying a number of installer builders. Using the Cryptol template as our example, let's do a walkthrough of its installation template module (we're assuming that you're vaguely familiar with Haskell syntax): > module Cryptol where > > import Bamse.Package; import Bamse.PackageUtils > > import Data.List ( intersperse ) > import Util.Dir ( DirTree(..), findFiles ) > import Util.Path ( baseName ) > All installer builder template import the 'Bamse.Package' and 'Bamse.PackageUtils' modules to bring into scope various types and utility functions. In addition to these, the Cryptol template requires some list and directory/path processing functions; the former is imported from a standard Haskell module, the latter from the Galois Haskell library. OK, first some helper definitions: > > pkgName, pkgVersion :: String > pkgName = "Cryptol" > pkgVersion = "1.4" > While neither 'pkgName' nor 'pkgVersion' are used outside of this template module, abstracting them out as local definitions is handy. > -- what to output the MSI as if no -o option is given. > defaultOutFile = PackageUtils.toMsiFileName (pkgName ++ '-':pkgVersion) > The 'bamse' tool supports a standard set of command-line options, one of which is the name of the file the builder should output the installer as. In the event the user doesn't supply this option, 'defaultOutFile' is used. To make sure we don't run afoul MSI restrictions on filenames, 'PackageUtils.toMsiFileName' is used to translate the default filename into a valid MSI filename. > -- 'information summary stream' data bundled up together. > pkg :: Package > pkg = Package > { name = pkgName > , title = pkgName ++ ", version " ++ pkgVersion > , productVersion = "1.4.2.0" > , author = "Galois Connections, Inc." > , comment = unwords [pkgName, "Version", pkgVersion] > } The next definition collects together informational data about the installer you're creating a builder for. The Package.Package data type is defined as follows: > data Package > = Package { > name :: String > -- ^ The name of the product which the installer provides. > , title :: String > -- ^ Brief description of installer contents. > , productVersion :: String > -- ^ productVersion format: > -- major.minor.build[.whatever] > -- > , author :: String > -- ^ name of manufacturer of the installer > , comment :: String > -- ^ short text describing purpose of installer > } The meaning of these individual fields are hopefullly self-evident. The URL associated with a product is given via the 'webSite' definition: > > webSite :: String > webSite = "http://www.cryptol.net/" > Currently, this URL is only used when specifying the 'help URL' associated with an installer. Customisation of an installer's UI is possible in a number of ways; you can for instance specify the bitmaps to use as backdrop and a banner: > > bannerBitmap :: InstallEnv -> Maybe FilePath > bannerBitmap ienv = Just (lFile (toolDir ienv) "art/banner3.bmp") > > bgroundBitmap :: InstallEnv -> Maybe FilePath > bgroundBitmap ienv = Just (lFile (toolDir ienv) "art/bground2.bmp") > These are specified as functions, taking an 'InstallEnv' describing the context the installer is invoked from. The 'toolDir' field of an 'InstallEnv' specifies the toplevel directory of the installer builder tool itself. It it used here to get hold of some standard bitmaps without having to hardwire their paths into the template. If you simply want to use the standard UI, have both of these functions return 'Nothing'. The 'InstallEnv' type is defined as follows: > data InstallEnv > = InstallEnv > { toolDir :: FilePath -- ^ where installer tool lives > , srcDir :: FilePath -- ^ path to toplevel directory of files to be distributed. > , dataDir :: FilePath -- ^ user-supplied path to directory containing installer > -- template specific files. > } The 'dataDir' field holds the path to a directory which contains files particular to all installers for your product; for instance, instead of using 'toolDir' above to get hold of bitmap files, 'dataDir' could be used to get hold of Cryptol specific distribution/installer files. The 'srcDir' directory points to the top of the directory tree you want to package up. Some products require the use of the Registry to store installation specific data in order to operate properly. To specify what actions the installer should perform upon the Registry upon installation (and un-installation), the 'registry' list is used: > > registry :: [RegEntry] > registry = cryptolSettings ++ haskellProject "Cryptol" [....] > In the case of Cryptol, it consists of two parts, one to setup the Cryptol-specific Registry data, the other to integrate Cryptol with your the Haskell interpreter Hugs98. For grubby Hugs versioning issues, the setup of the latter is a little bit involved, so let's focus on the Cryptol-specific options only (see the real template module for complete details.) > > cryptolSettings = > [ RegEntry "HKCU" "Software" (CreateKey False) > , RegEntry "HKCU" "Software\\Cryptol" (CreateKey True) > , RegEntry "HKCU" "Software\\Cryptol" (CreateName (Just "Options") "") > , RegEntry "OnInstall" "Software" (CreateKey False) > , RegEntry "OnInstall" "Software\\Cryptol" (CreateKey True) > , RegEntry "OnInstall" "Software\\Cryptol" (CreateName (Just "InstallDir") "[TARGETDIR]") > ] > Each 'RegEntry' consists of three fields; the first specifies the hive (Registry lingo for the toplevel directory/key), the second the path to the key/value to install within that hive. Notice the use of the 'OnInstall' hive here; it is a meta-hive name which is used to specify Registry data that is supposed to go into either the machine or user-specific portion/hive of the Registry. Which one is decided when when the user installing the software picks a per-machine or a per-user installation. The third argument to RegEntry specifies what action to perform on the given Registry key/value -- it is defined as follows: > > data KeyAction > = CreateKey Bool -- True => delete on uninstall > | CreateName (Maybe String) -- Just x => default name for the name. > String > | DeleteKey Bool -- True => remove key on _install_ > -- False => remove key on _uninstall_ > | DeleteName Bool String -- True => remove name on _install_ > -- False => remove name on _uninstall_ > You'll be using the first two constructors most of the time to hygenically install and un-install Registry entries for your product; 'cryptolSettings' doing just this for Cryptol, being a good citizen by deleting its Registry tree when the application is uninstalled. Next item on the list of things a template needs to provide is the specification of 'features': an installer can partition the files it distributes into a set of features, each of which the user can decide whether or not to install locally. The root or base feature is specified via 'baseFeature': > baseFeature :: Feature > baseFeature = (baseFeatureName, pkgName ++ '-':pkgVersion) > > baseFeatureName :: String > baseFeatureName = pkgName > > features :: [Feature] > features = [baseFeature] Associated with the base feature are all essential files of your product + installer features such as start menu entries, desktop shortcuts, registry entries etc. The base feature is unique in that the user cannot opt not to install it. The other features, specified via 'features', can be de-selected at install-time by the user. [Note: it is currently not possible to associate files/directories with other features than 'baseFeature', making 'features' rather useless as-is. Only thing it gives you is an selectable option on the customised-install dialog.] Integrating your product into the Windows graphical shell is supported in a number of ways: start menu entries, desktop shortcuts, custom filetypes and the definition of operations over these custom files. Start menu items are defined via 'startMenu': > > startMenu :: InstallEnv -> (String, [Shortcut]) > startMenu ienv = (pkgName, shortcuts ienv) > In dictatorial fashion, 'bamse' will only let you install start menu items in a separate folder inside the programs folder. The first component of the 'startMenu's result pair is the folder to create (and delete upon uninstall) -- sub-folders are created by specifying a relative path here, e.g., "Cryptol/version1.4" (see the GHC template for an example of this.) The second component contain the shortcuts you want to have appear in that menu. The 'Shortcut' data type is defined as follows: > > data Shortcut > = Shortcut > { scut_name :: String -- name > , scut_target :: String -- target app > , scut_args :: String -- arguments > , scut_desc :: String -- description > , scut_icon :: Maybe FilePath -- icon file > , scut_istate :: Int -- initial state > , scut_wdir :: String -- working dir. > } > The fields are best explained via an actual example: > shortcuts :: InstallEnv -> [Shortcut] > shortcuts ienv = > [ Shortcut "Cryptol interpreter" > (lFile topDir "bin\\cryptol.exe") > "" > "Cryptol interpreter" > (Just (lFile iconDir "cry.exe")) > 1 > "[TARGETDIR]" > ] > where > topDir = srcDir ienv > iconDir = lFile (toolDir ienv) "icons" The first component is the display name of the shortcut, the second is the target file of the shortcut -- here, the binary of the Cryptol interpreter. The third argument contain any command-line arguments to pass the target, the fourth is the descriptive text (i.e., verbiage that shows up when you hold the mouse cursor over the item). Next is the icon to associate with the shortcut; -- see section Foo on details on how to create your icon files -- here, the icon is the "standard" Cryptol icon that comes bundled with 'bamse'. The second to last field control how to initially show the shortcut application once launched; 1 meaning show a normal window (3 = show maximized; 7=show minimized.) The last field is the initial working directory of the launched application -- "[TARGETDIR]" is a meta-directory name that gets expanded by the Microsoft Installer Runtime to the directory where the product ended up being installed locally. Note: if you don't want a start menu folder installed with your product, simply leave 'startMenu's shortcut list as empty. The Shortcut data type is naturally also used when specifying desktop shortcuts: > > desktopShortcuts :: InstallEnv -> [Shortcut] > desktopShortcuts ienv = shortcuts ienv > Making Cryptol install both a start menu and desktop shortcut to its interpreter. To further embed your product into the Windows shell, you have the option of registering custom filename extensions + actions to perform support over these: > > extensions :: InstallEnv -> [ Extension ] > extensions ienv = [ cryptolExtension (srcDir ienv (toolDir ienv) "cry" ] > ] The '.cry' file extension is here associated with the Cryptol interpreter, > cryptolExtension :: FilePath -> FilePath -> String -> Extension > cryptolExtension topDir toolDir ext > = ( "CryptolFile" -- (unique) extension label > , lFile topDir "bin\\cryptol.exe" > , lFile iconDir "cry.exe" > , ext > ) > where > iconDir = lFile toolDir "icons" > together with the icon contained in the 'cry.exe' resource binary. Operations on this file type is specified via the 'verbs' definition: > verbs :: [ ( String -- extension > , String -- verb > , String -- label > , String -- arguments > ) > ] > verbs = [ ( "cry" > , "open" > , "&Open" > , "\"%1\"")] > The standard 'open' action is here defined to pass the file path of the opened/double-clicked .cry file as command-line argument to the application associated with it (cryptol.exe). The third component is the display name to use in the context menu. Why separate the specification of verbs from that of the extension? Because an installer may want to install verbs/actions for file types other than those which it installs, e.g., if you're packaging up a PDF manipulation tool, you'd probably want to register actions that invoke your tool when right-clicking on .pdf files. In case you want the user to fill in registration details upon install, set 'userRegistration' to True: > > userRegistration :: Bool > userRegistration = False > If you do, the edit fields that the user fills in are available via the 'USERNAME', 'COMPANYNAME', and 'PIDKEY' properties. You can optionally require the user to agree with your product's license upon installing by making 'license' point to a RTF file containing the license text: > > license :: InstallEnv -> Maybe FilePath > license _ienv = Nothing > By default, your product will be installed locally in the 'Program files' folder (in the 'pkg.title' folder.) To override this and insist on a different default location, use 'defaultInstallFolder': > > defaultInstallFolder :: Maybe FilePath > defaultInstallFolder = Nothing > For instance, GHC uses this option to good effect to encourage the user to install this in the 'ghc' folder on the root drive, > > defaultInstallFolder = Just $ "[WindowsVolume]ghc\\"++ghcVersion > where 'WindowsVolume' is a property that expands to the name of the drive holding your windows installation, e.g., "c:\\". After having installed the product, the standard UI displays a final dialog where the user has to click 'Finish' to complete the joyous process. Should you want to override the rather bland text that is included in that dialog, use 'finalMessage': > > finalMessage :: Maybe String > finalMessage = Just "Please remember to add [TARGETDIR]bin to your PATH." > where 'TARGETDIR' is expanded by the installer to the location where the user ended up putting the product. It's often worthwhile to offer the user the alternative of being able to install your product without requiring the user to have Administrative privileges on his/her machine. To enable this, set 'userInstall' to True: > > userInstall :: Bool > userInstall = True > which causes the installer UI to include a dialog that lets the user select between a user-only and a machine-wide installation. The Windows Installer framework provides special support for installing and configuring Windows Services -- if your product contains one or more of these, include a non-empty list when defining 'services': > > services :: [Service] > services = [] > ToDo: include Service data type + explanation To give GHC users a helping hand in distributing packages, 'bamse' provides special support for installing GHC packages. To make use of it, define the properties of the package via the 'ghcPackageInfo' definition: > > ghcPackageInfo :: Maybe GhcPackage > ghcPackageInfo = Nothing > And last, but not least, to specify which files are to be included inb your installer by supplying a definition of a 'dirTrees' function: > > dirTree :: InstallEnv -> IO DirTree > dirTree ienv = Util.Dir.findFiles ofInterest (srcDir ienv) > where > ofInterest file = not (last file == '~') && > not (baseName file == "CVS") > Given the path to the directory containing the files we want to distribute with Cryptol, we include all files except CVS directories and backup files. Sometimes the directory tree returned by 'dirTree' isn't equal to the directory tree you want to install them as. Rather than force the installer user to manually create an install tree layout that matches, you can specify the translation via a 'distFileMap' function: > > distFileMap :: Maybe (FilePath -> Maybe FilePath) > distFileMap = Nothing > If not equal to 'Nothing', the distFileMap will be applied to each file and directory in the 'DirTree' returned by 'dirTree'. The result is where that particular file/directory is to be put inside the installed directory tree. If the entity isn't after all to be included in the distribution, the 'distFileMap' function simply return Nothing. Experimental support for nested installaters (i.e., MSIs containing other MSIs) are provided via 'nestedInstalls' defn. This doesn't apply to Cryptol, so its definition is the empty list: > > nestedInstalls :: [(String, String)] > nestedInstalls = [] > [For an example of how 'nestedInstalls' can be use, have a look at the installer for Bamse itself, templates/Bamse.hs ] To summarise, a template module needs to export the following signature: > module PackageSrc > ( defaultOutFile -- :: FilePath > , pkg -- :: Package > , webSite -- :: String > , bannerBitmap -- :: InstallEnv -> Maybe FilePath > , bgroundBitmap -- :: InstallEnv -> Maybe FilePath > , registry -- :: [RegEntry] > , baseFeature -- :: Feature > , features -- :: [Feature] > , startMenu -- :: InstallEnv -> (String, [Shortcut]) > , desktopShortcuts -- :: InstallEnv -> [Shortcut] > , extensions -- :: InstallEnv -> [Extension] > , verbs -- :: [Extension] > , license -- :: InstallEnv -> Maybe FilePah > , userRegistration -- :: Bool > , defaultInstallFolder -- :: Maybe String > , dirTree -- :: InstallEnv -> IO DirTree > , distFileMap -- :: Maybe (FilePath -> Maybe FilePath) > , featureMap -- :: Maybe (FilePath -> FeatureName) > , finalMessage -- :: Maybe String > , userInstall -- :: Bool > , services -- :: [Service] > , ghcPackageInfo -- :: Maybe GhcPackage > , nestedInstalls -- :: [(String, Maybe String)] > ) where