1; NSIS Modern User Interface version 1.63
2; Erlang OTP installation script based on "Start Menu Folder Selection
3; Example Script"
4; Original example written by Joost Verburg
5; Modified for Erlang by Patrik
6
7;
8; %CopyrightBegin%
9;
10; Copyright Ericsson AB 2012-2016. All Rights Reserved.
11;
12; Licensed under the Apache License, Version 2.0 (the "License");
13; you may not use this file except in compliance with the License.
14; You may obtain a copy of the License at
15;
16;     http://www.apache.org/licenses/LICENSE-2.0
17;
18; Unless required by applicable law or agreed to in writing, software
19; distributed under the License is distributed on an "AS IS" BASIS,
20; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
21; See the License for the specific language governing permissions and
22; limitations under the License.
23;
24; %CopyrightEnd%
25;
26
27; Verbosity does not come naturally with MUI, have to set it back now and then.
28	!verbose 1
29	!define MUI_MANUALVERBOSE 1
30
31	!define OTP_PRODUCT "Erlang OTP"
32
33	!include "erlang.nsh" ; All release specific parameters come from this
34
35	Name "${OTP_PRODUCT} ${OTP_VERSION}"
36
37	!include "MUI.nsh"
38	!include "WordFunc.nsh"
39	!include "WinVer.nsh"
40;--------------------------------
41;Configuration
42
43	SetCompressor bzip2
44
45Var MYTEMP
46;Var MUI_TEMP
47Var STARTMENU_FOLDER
48
49
50!define  MY_STARTMENUPAGE_REGISTRY_ROOT HKLM
51!define  MY_STARTMENUPAGE_REGISTRY_KEY "SOFTWARE\Ericsson\Erlang\${ERTS_VERSION}"
52!define MY_STARTMENUPAGE_REGISTRY_VALUENAME "Start Menu Folder"
53
54;General
55	OutFile "${OUTFILEDIR}\otp_${WINTYPE}_${OTP_RELEASE_VERSION}.exe"
56
57;Folder selection page
58!if ${WINTYPE} == "win64"
59  	InstallDir "$PROGRAMFILES64\erl-${OTP_RELEASE_VERSION}"
60!else
61  	InstallDir "$PROGRAMFILES\erl-${OTP_RELEASE_VERSION}"
62!endif
63;Remember install folder
64  	InstallDirRegKey HKLM "SOFTWARE\Ericsson\Erlang\${ERTS_VERSION}" ""
65
66; Set the default start menu folder
67
68!if ${WINTYPE} == "win64"
69	!define MUI_STARTMENUPAGE_DEFAULTFOLDER "${OTP_PRODUCT} ${OTP_VERSION} (x64)"
70!else
71	!define MUI_STARTMENUPAGE_DEFAULTFOLDER "${OTP_PRODUCT} ${OTP_VERSION} (i386)"
72!endif
73
74;--------------------------------
75;Modern UI Configuration
76!ifdef HAVE_CUSTOM_MODERN
77	!define MUI_UI "custom_modern.exe"
78!endif
79        !define MUI_ICON "erlang_inst.ico"
80        !define MUI_UNICON "erlang_uninst.ico"
81
82  	!insertmacro MUI_PAGE_COMPONENTS
83  	!insertmacro MUI_PAGE_DIRECTORY
84; Registry keys where start menu folder is stored
85
86  	!define MUI_STARTMENUPAGE_REGISTRY_ROOT ${MY_STARTMENUPAGE_REGISTRY_ROOT}
87  	!define MUI_STARTMENUPAGE_REGISTRY_KEY "${MY_STARTMENUPAGE_REGISTRY_KEY}"
88  	!define MUI_STARTMENUPAGE_REGISTRY_VALUENAME "${MY_STARTMENUPAGE_REGISTRY_VALUENAME}"
89
90        !insertmacro MUI_PAGE_STARTMENU Application $STARTMENU_FOLDER
91
92	!insertmacro MUI_PAGE_INSTFILES
93
94        !insertmacro MUI_UNPAGE_CONFIRM
95        !insertmacro MUI_UNPAGE_INSTFILES
96
97;--------------------------------
98;Languages
99
100  	!insertmacro MUI_LANGUAGE "English"
101
102;--------------------------------
103;Language Strings
104
105;Description
106  	LangString DESC_SecErlang ${LANG_ENGLISH} "Erlang OTP."
107  	LangString DESC_SecErlangDev ${LANG_ENGLISH} \
108		"Erlang OTP development environment (required)."
109  	LangString DESC_SecErlangAssoc ${LANG_ENGLISH} \
110		"Erlang filetype associations (.erl, .hrl, .beam)."
111!ifdef HAVE_DOCS
112  	LangString DESC_SecErlangDoc ${LANG_ENGLISH} "Documentation."
113!endif
114!ifdef HAVE_REDIST_FILE
115  	LangString DESC_SecMSRedist ${LANG_ENGLISH} "Microsoft redistributable C runtime libraries, these are mandatory for Erlang runtime and development. Always installed if not already present."
116!endif
117;--------------------------------
118; WordFunc
119!ifdef HAVE_REDIST_FILE
120	!insertmacro VersionCompare
121!endif
122;--------------------------------
123;Installer Sections
124
125!ifdef HAVE_REDIST_FILE
126Section "Microsoft redistributable libraries." SecMSRedist
127
128  	SetOutPath "$INSTDIR"
129	File "${TESTROOT}\${REDIST_EXECUTABLE}"
130
131; Set back verbosity...
132  	!verbose 1
133; Run the setup program
134	IfSilent +3
135	    ExecWait '"$INSTDIR\${REDIST_EXECUTABLE}"'
136	Goto +2
137	    ExecWait '"$INSTDIR\${REDIST_EXECUTABLE}" /q /norestart'
138
139  	!verbose 1
140SectionEnd ; MSRedist
141!endif
142
143SubSection /e "Erlang" SecErlang
144Section "Development" SecErlangDev
145SectionIn 1 RO
146
147
148  	SetOutPath "$INSTDIR"
149
150; Don't let Users nor Autenticated Users group create new files
151; Avoid dll injection when installing to non /Program Files/ dirs
152
153        StrCmp $INSTDIR $InstallDir cp_files
154        ; Remove ANY inherited access control
155        ExecShellWait "open" "$SYSDIR\icacls.exe" '"$INSTDIR" /inheritance:r' SW_HIDE
156        ; Grant Admin full control
157        ExecShellWait  "open" "$SYSDIR\icacls.exe" '"$INSTDIR" /grant:r *S-1-5-32-544:(OI)(CI)F' SW_HIDE
158        ; Grant Normal Users read+execute control
159        ExecShellWait "open" "$SYSDIR\icacls.exe" '"$INSTDIR" /grant:r *S-1-1-0:(OI)(CI)RX' SW_HIDE
160
161cp_files:
162  	File "${TESTROOT}\Install.ini"
163  	File "${TESTROOT}\Install.exe"
164	SetOutPath "$INSTDIR\releases"
165  	File /r "${TESTROOT}\releases\"
166	SetOutPath "$INSTDIR\lib"
167  	File /r "${TESTROOT}\lib\"
168	SetOutPath "$INSTDIR\erts-${ERTS_VERSION}"
169  	File /r "${TESTROOT}\erts-${ERTS_VERSION}\"
170	SetOutPath "$INSTDIR\usr"
171  	File /r "${TESTROOT}\usr\"
172
173;Store install folder
174  	WriteRegStr HKLM "SOFTWARE\Ericsson\Erlang\${ERTS_VERSION}" "" $INSTDIR
175
176; Run the setup program
177  	Exec '"$INSTDIR\Install.exe" -s'
178
179; The startmenu stuff
180  	!insertmacro MUI_STARTMENU_WRITE_BEGIN Application
181; Set back verbosity...
182  	!verbose 1
183; Try to use the Common startmenu...
184  	SetShellVarContext All
185  	ClearErrors
186  	CreateDirectory "$SMPROGRAMS\$STARTMENU_FOLDER"
187  	IfErrors 0 continue_create
188    	;MessageBox MB_OK "Error creating file"
189    	SetShellVarContext current
190    	CreateDirectory "$SMPROGRAMS\$STARTMENU_FOLDER"
191continue_create:
192  	CreateShortCut "$SMPROGRAMS\$STARTMENU_FOLDER\Erlang.lnk" \
193		"$INSTDIR\bin\werl.exe"
194
195  	!insertmacro MUI_STARTMENU_WRITE_END
196; And once again, the verbosity...
197  	!verbose 1
198; Check that the registry could be written, we only check one key,
199; but it should be sufficient...
200  	ReadRegStr $MYTEMP ${MY_STARTMENUPAGE_REGISTRY_ROOT}  "${MY_STARTMENUPAGE_REGISTRY_KEY}" "${MY_STARTMENUPAGE_REGISTRY_VALUENAME}"
201
202  	StrCmp $MYTEMP "" 0 done_startmenu
203
204; If startmenu was skipped, this might be unnecessary, but wont hurt...
205  	WriteRegStr HKCU "Software\Ericsson\Erlang\${ERTS_VERSION}" \
206		"" $INSTDIR
207  	WriteRegStr HKCU "${MY_STARTMENUPAGE_REGISTRY_KEY}" \
208		"${MY_STARTMENUPAGE_REGISTRY_VALUENAME}" \
209		"$STARTMENU_FOLDER"
210
211
212done_startmenu:
213;Create uninstaller
214  	WriteUninstaller "$INSTDIR\Uninstall.exe"
215
216  	WriteRegStr HKLM \
217		"SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})" \
218		"DisplayName" "Erlang OTP ${OTP_RELEASE_VERSION} (${ERTS_VERSION})"
219  	WriteRegStr HKLM \
220		"SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})" \
221		"UninstallString" "$INSTDIR\Uninstall.exe"
222  	WriteRegDWORD HKLM \
223		"SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})" \
224		"NoModify" 1
225  	WriteRegDWORD HKLM \
226		"SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})" \
227		"NoRepair" 1
228
229; Check that the registry could be written, we only check one key,
230; but it should be sufficient...
231  	ReadRegStr $MYTEMP HKLM \
232	"SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})" \
233	"NoRepair"
234
235  	StrCmp $MYTEMP "" 0 done
236
237; Now we're done if we are a superuser. If the registry stuff failed, we
238; do the things below...
239
240  	WriteRegStr HKCU \
241		"Software\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})" \
242		"DisplayName" "Erlang OTP ${OTP_RELEASE_VERSION} (${ERTS_VERSION})"
243  	WriteRegStr HKCU \
244		"Software\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})" \
245		"UninstallString" "$INSTDIR\Uninstall.exe"
246  	WriteRegDWORD HKCU \
247		"Software\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})" \
248		"NoModify" 1
249  	WriteRegDWORD HKCU \
250		"Software\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})" \
251		"NoRepair" 1
252
253done:
254SectionEnd ; SecErlangDev
255
256Section "Associations" SecErlangAssoc
257
258  	;File /r "${TESTROOT}\usr\lib\icons"
259
260; .erl
261  	DeleteRegKey HKCR ".erl"
262  	DeleteRegKey HKCR "ErlangSource"
263  	WriteRegStr HKCR ".erl" "" "ErlangSource"
264	WriteRegStr HKCR "ErlangSource" "" "Erlang source file"
265	WriteRegStr HKCR "ErlangSource\shell\compile" "" "Compile"
266	WriteRegStr HKCR "ErlangSource\shell\compile\command" "" \
267		'"$INSTDIR\bin\erlc.exe" "%1"'
268	WriteRegStr HKCR "ErlangSource\DefaultIcon" "" \
269		$INSTDIR\usr\lib\icons\erl_icon.ico
270; .hrl
271  	DeleteRegKey HKCR ".hrl"
272  	DeleteRegKey HKCR "ErlangHeader"
273  	WriteRegStr HKCR ".hrl" "" "ErlangHeader"
274	WriteRegStr HKCR "ErlangHeader" "" "Erlang header file"
275	WriteRegStr HKCR "ErlangHeader\DefaultIcon" "" \
276		$INSTDIR\usr\lib\icons\hrl_icon.ico
277
278; .beam
279  	DeleteRegKey HKCR ".beam"
280  	DeleteRegKey HKCR "ErlangBeam"
281  	WriteRegStr HKCR ".beam" "" "ErlangBeam"
282	WriteRegStr HKCR "ErlangBeam" "" "Erlang beam code"
283	WriteRegStr HKCR "ErlangBeam\DefaultIcon" "" \
284		$INSTDIR\usr\lib\icons\beam_icon.ico
285
286
287	SearchPath $1 "write.exe"
288	StrCmp $1 "" writeNotFound
289	WriteRegStr HKCR "ErlangSource\shell" "" "Open"
290  	WriteRegStr HKCR "ErlangSource\shell\open\command" "" \
291		'"$1" "%1"'
292	WriteRegStr HKCR "ErlangHeader\shell" "" "Open"
293  	WriteRegStr HKCR "ErlangHeader\shell\open\command" "" \
294		'"$1" "%1"'
295
296
297writeNotFound:
298SectionEnd ; SecErlangAssoc
299SubSectionEnd
300
301!ifdef HAVE_DOCS
302Section "Erlang Documentation" SecErlangDoc
303
304  	SetOutPath "$INSTDIR"
305  	File /r "${TESTROOT}\docs\*"
306
307; The startmenu stuff
308  	!insertmacro MUI_STARTMENU_WRITE_BEGIN Application
309; Set back verbosity...
310  	!verbose 1
311; Try to use the Common startmenu...
312  	SetShellVarContext All
313  	ClearErrors
314  	CreateShortCut "$SMPROGRAMS\$STARTMENU_FOLDER\Erlang Documentation.lnk" \
315		"$INSTDIR\doc\index.html"
316  	IfErrors 0 continue_create
317    	;MessageBox MB_OK "Error creating file"
318    	SetShellVarContext current
319  	CreateShortCut \
320		"$SMPROGRAMS\$STARTMENU_FOLDER\Erlang Documentation.lnk" \
321		"$INSTDIR\doc\index.html"
322continue_create:
323
324  	!insertmacro MUI_STARTMENU_WRITE_END
325; And once again, the verbosity...
326  	!verbose 1
327SectionEnd ; ErlangDoc
328!endif
329
330!ifdef HAVE_REDIST_FILE
331Function DllVersionGoodEnough
332    IntCmp 0 $R0 normal0 normal0 negative0
333    normal0:
334        IntOp $R2 $R0 >> 16
335	Goto continue0
336    negative0:
337	IntOp $R2 $R0 & 0x7FFF0000
338	IntOp $R2 $R2 >> 16
339	IntOp $R2 $R2 | 0x8000
340    continue0:
341    IntOp $R3 $R0 & 0x0000FFFF
342    IntCmp 0 $R1 normal1 normal1 negative1
343    normal1:
344        IntOp $R4 $R1 >> 16
345	Goto continue1
346    negative1:
347	IntOp $R4 $R1 & 0x7FFF0000
348	IntOp $R4 $R4 >> 16
349	IntOp $R4 $R4 | 0x8000
350    continue1:
351    IntOp $R5 $R1 & 0x0000FFFF
352    StrCpy $2 "$R2.$R3.$R4.$R5"
353    ${VersionCompare} $2 ${REDIST_DLL_VERSION} $R0
354    Return
355FunctionEnd
356
357Function .onInit
358   Var /GLOBAL archprefix
359   Var /GLOBAL sysnativedir
360   Var /GLOBAL winvermajor
361   Var /GLOBAL winverminor
362
363   SectionGetFlags 0 $MYTEMP
364   StrCmpS ${WINTYPE} "win64" +1 +4
365	StrCpy $archprefix "amd64"
366	StrCpy $sysnativedir "$WINDIR\sysnative"
367   Goto +3
368	StrCpy $archprefix "x86"
369	StrCpy $sysnativedir $SYSDIR
370   ${WinVerGetMajor} $0
371   ${WinVerGetMinor} $1
372   StrCpy $winvermajor $0
373   StrCpy $winverminor $1
374   IfFileExists $sysnativedir\${REDIST_DLL_NAME} MaybeFoundInSystemLbl
375   SearchSxSLbl:
376        IntCmp $winvermajor 6 WVCheckMinorLbl WVCheckDoneLbl NotFoundLbl
377   WVCheckMinorLbl:
378	IntCmp $winverminor 1 WVCheckDoneLbl WVCheckDoneLbl NotFoundLbl
379   WVCheckDoneLbl:
380        FindFirst $0 $1 $WINDIR\WinSxS\$archprefix*
381        LoopLbl:
382	    StrCmp $1 "" NotFoundLbl
383	    IfFileExists $WINDIR\WinSxS\$1\${REDIST_DLL_NAME} MaybeFoundInSxSLbl
384	    FindNext $0 $1
385	    Goto LoopLbl
386        MaybeFoundInSxSLbl:
387	    GetDllVersion $WINDIR\WinSxS\$1\${REDIST_DLL_NAME} $R0 $R1
388	    Call DllVersionGoodEnough
389	    FindNext $0 $1
390	    IntCmp 2 $R0 LoopLbl
391	    Goto FoundLbl
392   MaybeFoundInSystemLbl:
393	GetDllVersion $sysnativedir\${REDIST_DLL_NAME} $R0 $R1
394	Call DllVersionGoodEnough
395	IntCmp 2 $R0 SearchSxSLbl
396   FoundLbl:
397	IntOp $MYTEMP $MYTEMP & 4294967294
398	SectionSetFlags 0 $MYTEMP
399	SectionSetText 0 "Microsoft DLL's (present)"
400	Return
401   NotFoundLbl:
402        IntOp $MYTEMP $MYTEMP | 16
403	SectionSetFlags 0 $MYTEMP
404	SectionSetText 0 "Microsoft DLL's (needed)"
405	Return
406FunctionEnd
407!endif
408
409
410;Display the Finish header
411;Insert this macro after the sections if you are not using a finish page
412;	!insertmacro MUI_SECTIONS_FINISHHEADER
413
414;--------------------------------
415;Descriptions
416
417	!insertmacro MUI_FUNCTION_DESCRIPTION_BEGIN
418  	!insertmacro MUI_DESCRIPTION_TEXT ${SecErlang} $(DESC_SecErlang)
419  	!insertmacro MUI_DESCRIPTION_TEXT ${SecErlangDev} $(DESC_SecErlangDev)
420  	!insertmacro MUI_DESCRIPTION_TEXT ${SecErlangAssoc} \
421		$(DESC_SecErlangAssoc)
422!ifdef HAVE_DOCS
423  	!insertmacro MUI_DESCRIPTION_TEXT ${SecErlangDoc} $(DESC_SecErlangDoc)
424!endif
425!ifdef HAVE_REDIST_FILE
426  	!insertmacro MUI_DESCRIPTION_TEXT ${SecMSRedist} $(DESC_SecMSRedist)
427!endif
428	!insertmacro MUI_FUNCTION_DESCRIPTION_END
429
430;--------------------------------
431;Uninstaller Section
432
433Section "Uninstall"
434
435  	RMDir /r "$INSTDIR"
436
437;Remove shortcut
438  	ReadRegStr $MYTEMP "${MY_STARTMENUPAGE_REGISTRY_ROOT}" \
439		"${MY_STARTMENUPAGE_REGISTRY_KEY}" \
440		"${MY_STARTMENUPAGE_REGISTRY_VALUENAME}"
441	StrCmp $MYTEMP "" 0 end_try
442; Try HKCU instead...
443  	ReadRegStr $MYTEMP "${MY_STARTMENUPAGE_REGISTRY_ROOT}" \
444		"${MY_STARTMENUPAGE_REGISTRY_KEY}" \
445		"${MY_STARTMENUPAGE_REGISTRY_VALUENAME}"
446; If this failed to, we have no shortcuts (eh?)
447  	StrCmp $MYTEMP "" noshortcuts
448end_try:
449  	SetShellVarContext All
450  	ClearErrors
451; If we cannot find the shortcut, switch to current user context
452  	GetFileTime "$SMPROGRAMS\$MYTEMP\Erlang.lnk" $R1 $R2
453  	IfErrors 0 continue_delete
454    	;MessageBox MB_OK "Error removing file"
455    	SetShellVarContext current
456continue_delete:
457  	Delete "$SMPROGRAMS\$MYTEMP\Erlang.lnk"
458  	Delete "$SMPROGRAMS\$MYTEMP\Uninstall.lnk"
459  	Delete "$SMPROGRAMS\$MYTEMP\Erlang Documentation.lnk"
460  	RMDir "$SMPROGRAMS\$MYTEMP" ;Only if empty
461
462noshortcuts:
463; We delete both in HKCU and HKLM, we don't really know were they might be...
464  	DeleteRegKey /ifempty HKLM "SOFTWARE\Ericsson\Erlang\${ERTS_VERSION}"
465  	DeleteRegKey /ifempty HKCU "SOFTWARE\Ericsson\Erlang\${ERTS_VERSION}"
466  	DeleteRegKey HKLM \
467		"SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})"
468  	DeleteRegKey HKCU \
469		"SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})"
470
471
472; Now remove shell/file associations we'we made...
473; .erl
474  	ReadRegStr $1 HKCR ".erl" ""
475  	StrCmp $1 "ErlangSource" 0 NoOwnSource
476  	ReadRegStr $1 HKCR "ErlangSource\DefaultIcon" ""
477	StrCmp $1 "$INSTDIR\usr\lib\icons\erl_icon.ico" 0 NoOwnSource
478  	DeleteRegKey HKCR ".erl"
479  	DeleteRegKey HKCR "ErlangSource"
480NoOwnSource:
481; .hrl
482  	ReadRegStr $1 HKCR ".hrl" ""
483  	StrCmp $1 "ErlangHeader" 0 NoOwnHeader
484  	ReadRegStr $1 HKCR "ErlangHeader\DefaultIcon" ""
485	StrCmp $1 "$INSTDIR\usr\lib\icons\hrl_icon.ico" 0 NoOwnHeader
486  	DeleteRegKey HKCR ".hrl"
487  	DeleteRegKey HKCR "ErlangHeader"
488NoOwnHeader:
489
490; .beam
491  	ReadRegStr $1 HKCR ".beam" ""
492  	StrCmp $1 "ErlangBeam" 0 NoOwnBeam
493  	ReadRegStr $1 HKCR "ErlangBeam\DefaultIcon" ""
494	StrCmp $1 "$INSTDIR\usr\lib\icons\beam_icon.ico" 0 NoOwnBeam
495  	DeleteRegKey HKCR ".beam"
496  	DeleteRegKey HKCR "ErlangBeam"
497NoOwnBeam:
498
499;Display the Finish header
500;  	!insertmacro MUI_UNFINISHHEADER
501
502SectionEnd
503	!verbose 3
504