[MLton-commit] r7355

Wesley Terpstra wesley at mlton.org
Tue Nov 3 04:32:43 PST 2009


A more complete understanding of windows component rules has led me to 
discover that a component's GUID must depend only on its path, not content.

Gah.


----------------------------------------------------------------------

U   mlton/trunk/package/mingw/Makefile
U   mlton/trunk/package/mingw/files2wix.sml
U   mlton/trunk/package/mingw/mlton.wxs.in

----------------------------------------------------------------------

Modified: mlton/trunk/package/mingw/Makefile
===================================================================
--- mlton/trunk/package/mingw/Makefile	2009-11-03 02:19:33 UTC (rev 7354)
+++ mlton/trunk/package/mingw/Makefile	2009-11-03 12:32:43 UTC (rev 7355)
@@ -43,7 +43,8 @@
 	$(MLTON) $<
 
 mlton.wxs:	mlton.wxs.in guid.exe
-	sed "s/@VERSION@/$(VERSION)/g;s/@WINVERSION@/$(WINVERSION)/g;s/@GUID@/`./guid $(VERSION)`/g" \
+	sed "s/@VERSION@/$(VERSION)/g;s/@WINVERSION@/$(WINVERSION)/g" | \
+	sed "s/@GUID1@/`./guid $(VERSION).1`/g;s/@GUID2@/`./guid $(VERSION).2`/g" \
 	< $< > $@
 
 self32.lst:
@@ -95,5 +96,5 @@
 	cd staging; find * -type d | ../dirs2wix > ../$@.tmp
 	mv $@.tmp $@
 files.wxs:	files2wix.exe $(PKG_LST)
-	cat $(PKG_LST) | sort | uniq | ./files2wix `which md5sum` > ./$@.tmp
+	cat $(PKG_LST) | sort | uniq | ./files2wix > ./$@.tmp
 	mv $@.tmp $@

Modified: mlton/trunk/package/mingw/files2wix.sml
===================================================================
--- mlton/trunk/package/mingw/files2wix.sml	2009-11-03 02:19:33 UTC (rev 7354)
+++ mlton/trunk/package/mingw/files2wix.sml	2009-11-03 12:32:43 UTC (rev 7355)
@@ -1,9 +1,3 @@
-val md5sum =
-   case CommandLine.arguments () of
-      [md5sum] => md5sum
-    | _ => (print "Specify path to md5sum executable\n"; 
-            OS.Process.exit OS.Process.failure)
-
 val prefix = "\
    \<?xml version='1.0' encoding='windows-1252'?>\n\
    \<Wix xmlns='http://schemas.microsoft.com/wix/2006/wi'>\n\
@@ -49,49 +43,29 @@
                        \Guid='" ^ guid ^ "'>\n\
       \         <File Id='file." ^ uglypath ^ "' \
                      \Name='" ^ file ^ "' DiskId='1' Vital='yes' \
-                     \Source='staging/" ^ path ^ "' />\n\
+                     \Source='staging/" ^ path ^ "' KeyPath='yes' />\n\
       \      </Component>\n\
       \    </DirectoryRef>\n"
    end 
 and guid path = 
    let
-      val md5sum = 
+      val guid = 
          MLton.Process.create {
-            args = ["staging/" ^ path],
+            args = [path],
             env = NONE,
-            path = md5sum,
+            path = "./guid",
             stdin  = MLton.Process.Param.null,
             stderr = MLton.Process.Param.self,
             stdout = MLton.Process.Param.pipe
          }
-      val input = MLton.Process.Child.textIn (MLton.Process.getStdout md5sum)
-      val md5 =
+      val input = MLton.Process.Child.textIn (MLton.Process.getStdout guid)
+      val out =
          case TextIO.inputLine input of
-            NONE => raise Fail "md5sum provided no hash"
+            NONE => raise Fail "guid provided no hash"
           | SOME s => s
-      val _ = MLton.Process.reap md5sum
-      
-      (* Compute the GUID as the combiniation of content hash + path hash *)
-      val pathHash = foldl hash 0w0 (explode path)
-      val contentHash = valOf (Word64.fromString (String.substring (md5, 0, 16)))
-      val xor = Word64.xorb (pathHash, contentHash)
-      
-      val zero = "00000000"
-      fun pad i s = String.substring (zero, 0, i - String.size s) ^ s 
-      val c32 = pad 8 o Word32.toString o Word32.fromLarge o Word64.toLarge
-      val c16 = pad 4 o Word16.toString o Word16.fromLarge o Word64.toLarge
-      fun s32 i = String.substring (md5, i, 8)
-      fun s16 i = String.substring (md5, i, 4)
-      val s = Word64.>>
-      
-      val a32 = c32 (s (xor, 0w32))
-      val b16 = c16 (s (xor, 0w16))
-      val c16 = c16 xor
-      val d16 = s16 16
-      val e16 = s16 20
-      val f32 = s32 24
+      val _ = MLton.Process.reap guid
    in
-      concat [a32, "-", b16, "-", c16, "-", d16, "-", e16, f32 ]
+      out
    end
 
 fun tail path = String.substring (path, 0, String.size path - 1)

Modified: mlton/trunk/package/mingw/mlton.wxs.in
===================================================================
--- mlton/trunk/package/mingw/mlton.wxs.in	2009-11-03 02:19:33 UTC (rev 7354)
+++ mlton/trunk/package/mingw/mlton.wxs.in	2009-11-03 12:32:43 UTC (rev 7355)
@@ -1,23 +1,27 @@
 <?xml version='1.0' encoding='windows-1252'?>
 <Wix xmlns='http://schemas.microsoft.com/wix/2006/wi'>
-  <Product Name='MLton @VERSION@' Id='@GUID@'
+  <Product Name='MLton @VERSION@' Id='@GUID1@'
     UpgradeCode='C353A6D5-4A30-D7CF-62E2-04D98AF8A864'
     Language='1033' Codepage='1252' Version='@WINVERSION@' Manufacturer='MLton.org'>
 
-    <Package Id='*' Keywords='Installer'
+    <Package Id='@GUID2@' Keywords='Installer'
       Description="MLton Installer @VERSION@"
       Comments='MLton is an open-source, whole-program, optimizing Standard ML compiler.' Manufacturer='MLton.org'
       InstallerVersion='100' Languages='1033' Compressed='yes' SummaryCodepage='1252' />
 
     <Upgrade Id='C353A6D5-4A30-D7CF-62E2-04D98AF8A864'>
+      <UpgradeVersion OnlyDetect='yes' Property='BADFOUND'
+       Maximum='9.11.2' IncludeMaximum='yes' />
       <UpgradeVersion OnlyDetect='yes' Property='NEWERFOUND'
        Minimum='@WINVERSION@' IncludeMinimum='no' />
       <UpgradeVersion OnlyDetect='no' Property='PREVIOUSFOUND'
        Maximum='@WINVERSION@' IncludeMaximum='no' />
     </Upgrade>
     <CustomAction Id='NoDowngrade' Error='A newer version of MLton is already installed. If you want to downgrade, remove the newer version manually and try again.' />
+    <CustomAction Id='BrokenVersion' Error='The version of MLton installed on this machine cannot be upgraded. Please manually remove it and run the installer again.' />
     <InstallExecuteSequence>
       <Custom Action='NoDowngrade' After='FindRelatedProducts'>NEWERFOUND</Custom>
+      <Custom Action='BrokenVersion' After='FindRelatedProducts'>BADFOUND</Custom>
       <RemoveExistingProducts After='InstallFinalize'/>
     </InstallExecuteSequence>
 




More information about the MLton-commit mailing list