#!/bin/sh # # upgrade.tcl -- # # upgrade an existing epcEdit installation # # see the file upgrade.txt for a description of what it does. # # $Id: upgrade.tcl,v 1.5 2002/09/23 19:39:59 epccvs Exp $ # # \ DIR=`dirname $0`; \ LD_LIBRARY_PATH=$LD_LIBRARY_PATH:$DIR/..; \ export LD_LIBRARY_PATH ; \ exec $DIR/../../bin/wish8.3 "$0" "$@" # global variables used in this script # # version - the current epcEdit version # patchlevel - the current epcEdit patch level # instdir - the location of the epcEdit installation # urlbase - the URL of the upgrade server and directory package require http set patchlevel 0 set version 1.2 # from where do we get the update info? set urlbase "http://www.tksgml.de/upgrade" # if you need a proxy server to connect to the internet # specify the proxy's hostname and the proxy port for http here # if you don't need a proxy server put a comment sign (#) in front # of the next two lines #set proxyhost 192.168.231.100 #set proxyport 3128 # bug report URL set report_url "http://www.epcedit.com/Support/Feedback/Bug_Report/bug_report.html" # the place where temporary files should be stored set tempdir "" # the list of files to fetch (an array) global filelist # the file permissions for these files (an array, indexed by file names) global perms # the list of scripts to execute set scriptlist {} # the platform prefix for this version of epcEdit set platform "" # the current transaction state set tstate "" # the list of directories that we need to create. set dirlist {} # magic value to detect correct patchlevel.tcl file set defmagic 0x455043 # the variable where this script resides set scriptdir . set totalTransferred 0 set currentAction "" # the upgrade script will make backup copies of the overwritten files # in this directory (no copies will be made if set to an empty string) set bakdir "" # title image set image(titleSGML) [image create photo] $image(titleSGML) put { R0lGODdhhAE3APcAAAAAAAAIAAgAAAgICBAAAAgQCBAICBAQEBAYECgAABgYGBggGCAgIDgA ACAoIDgQGCgoKCgwKEAgIDAwMDA4MDgwMFgACGAACDg4ODhAOGgACGgIEFAwOEBAQEBIQEhA QFg4QEhISEhQSIAQGIAgKGhAQFBQUFBYUJAAEFhYWIgwOFhgWKAAEGBgYGBoYKAoMIBQWLAQ GGhoaGhwaLgIELAoMHBwcMAYKHhwcHB4cKhIUMgIGMAoMMgQGLg4QMgQIMgYIMAoOMgYKMAw OKBYYMggKLhASHh4eMggMNAIGMgoMNAQGJBocNAQIMgoONAYIMA4SHiAeMgwONAYKLhIUNAg KMBASMgwQNAgMNAoMMg4QNAoOLhQWKhgaMg4SMBIUNAwOICAgMhASNAwQNA4QLhYYMBQWICI gMhIUNA4SNBASNBAUMhQWLBocNBIUKhweIiIiNhASLBwcNBIWMBgaMhYYKh4eNBQWIiQiNhI ULB4eMhgaNBYYNhQWJCQkKiAiNBgaMhocNhYYJiQkJCYkLh4gKCIkNBgcMB4eNBocNhgaMhw eLiAiJiYmKiQkNhocLCIkMh4gLiIiJigmKCYmLiIkNhweNB4gKiYmMiAiLiQkKCgoOBweNCA iMCQkMiIkKigoKCooLiYmOB4gNiAiLCgoNCIkMCYmMiQmKioqLigoOCAiNCQmLCoqKiwqMCg oMiYoOCIkNCYmLioqNCYoLCwsMCoqMigqOCQmLiwsLC4sOCYmNigoMCwsNigqLi4uMCwuMiw sNCosOiYoNioqOCgqMC4uLjAuNCwsNiosMi4uOCosMDAwNC4uOiosMjAwMDIwNi4uOCwuNDA wOC4uOiwuMjIyNDAyNjAwOi4uNDIyMjQyOi4wNjIyNDQ0ODIyNDY0NjQ0PDAyODQ0NjY2OjQ 0ODY2Njg2OjY2ODg4PDY2ODo4Ojg4PDY4PDg4Ojo6PDo6P/o6PDw8P/w8P///wAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAhAE3AAAI/gDpCRxIsKDBgwgTKiwor+HC h/QaOkQo8WBFghLlCbwIkSPEjyBDWvQocqTGkiHJpUpV6yTKlzBjypxJc6A1DBQotIApL1UI Chg6ELJW0BqhDjg7TPI2MExOCiHICUyVASgFZvRsAHXxkFwUqy1SvYspz1WqUFJrJgS36WfQ oTPfEcKA85fag3gABFhw7u67s6nW3R1MuDDCFgH0FiBaUt6RAgD06nWAVeAvCJITB5jA2EXk xKEEnvgMQBe9EHo7LPSGIXHmFfBgelOgt5FhmxgkS3ZQS2aoA3oR9L7d6AACCOnuWhug1+7t 59BjvouQ2Q/Bdw7lYUcYakCAAidS/iDQm0IjMwd6AxwooDnDWM+aj9B711py7xCJMyiUJyKx AxcdJFaAKxFhd5J2EyHoEj3WIJAYHgtiN9Z12W0nkIEIeUOBXgMg4KBeEKQVEYIYaXdhgimA qMuE85lIoUYVnvQOiyQKlM4xzFSGYUMsbuQihgb9EkBirkToYnRIJkmQH0NKpp9AzEQwgQzb hBABBZsc1IhiYoUigwtHjHWEYjJYw4wLCyCwQCv0yKAbBfJYw55kpqEWgGoJzbNhABmQ49WX oNBzhJR4zCfCBBNM8k4jGUwQQQZ+EHVOBpotYIJG5OBBgaNHMEXPNpu2QM6hEfhBzhGOmpCc QVt+d4Y3/tacoBkcEVkjg5QZNLIqHo42kgoGEXRAVBTjfReBXeScgWgEUYQjkDVSygBOCDPQ k8IEFFgThqMpkLNJBxFgQCA9mzgaQjrrhDCBB9bM4KgNJ63TwrtURVBeQd5Q599O9HgThaMT nCGikgTf5kFkIiwAQAGV1SIgA58hkEqQxSKAARybrJrOhgCIAGM6OTIjGHx6LeDNJgPMGcB9 +S3k2WQpEPLLSY145zE56C3AjAwCIsAcBemYA4FrB3jQUwQBdOgdBUw9w5wDGUhWAAOaBeBB jxEdDEAKA6VzxAwzuDJPDsV+hgFWNpRcdgTe2OCdXgrUsokDmunFACH0HBNZ/rgd65n0CZAN yUDgACzQmx8lk5MOegM4wFzS8MqzwuMAfDjBggwuoNkBItBDCMR1O5BlwaQPts0BQzJjAnkC 6SIZBSZoxjVDLXyo2QQEpkM1ALTSA0cEEAA/MXwIUL1J7C1AVtppqS0ELeqfHZBCcjgDoIA3 NVttDXoBtMBMCAswMLEuxYZxzjtRA7CCN0ckFoI80LwNQQpDJp0CegszNpA8EwzJ1UG/cNCd XKCAxKxAHjlIz080k7HVBSAC1jjHnhxwq8mALDMdo8eeCpCC3QUAKpqpFh4SswBzLA5u4pnM X1AXgBC0AHpwYkgqmjSJdKRjaAGAwAzoBoAJYK10/kB8CZMAQIF5uMI/yXHdkH4xHQNaxBth EEEB7fYL3Q3pDAKxQd3w5qbNxC4E48lB4FgGgCcpJB26uFWxAnAC7KxAL0dYwZDgIA9ZVa4F RyAEM8YSjg9Nol/QW4Ef3Ja0Y1hDM6HZUwbkEQoO6W8jE9DLCq6TDuzAgYRMmcFk2JHAADDg HM8YDwD+KEcizkNOkcmSwyLDjGNoJgI22IQ80ucxQiiGGYtLTLUQt5dznBAAOZCHJgEAgXWk LQAOSM5oNoM5Br3NLszQDIE2IaBHBvGaIgkQABxwhi4GwC6/cKQ86jPJgmwDDngghDnYJ8oo pIM6W9NILVwQOLzBhwJn/nicAhoxRubdaSGbQGct0GgnBDirEUMyAXoUsA16pCOKCwCOxUwD DtoEwDbegJ6aFsDRBfzikImxizZDQA8lDsCa8nABCbVhGQpAAAKEuGThkhOFyDjgHVoEQATe 4Q0/0uONH4xTP6OZmFamZzgaZB01K+eNd0QyADKgR172YkLuhUFQQ4IAThOzU3rA53IGiV9I 6cGM9GDFpNbEplqdV7a6BYBrSlzMOJ1YEGaM5wC6ckWxaNW+AEgsHeA4AvRs89VjwJAZ/cQP ADBgQxv+kGdE9AY5VFo4qZwDMwXwTgiwE1MbNCIU9cHAO8gxRTiswxsKC0AY/BSyOD1OpHrx /gA9wvmdtM5wSB6AQxQw41dvECIxCNjEqPTiw5zutKJ6yVILIgOnnurFBg8VEDTKqhfGzHVr 9GikepqKNADskoSK4x4Wx7TNd7TPerXwRtSCahCQAiAU71hOYsKQjgRWrqFrze9CRrgwBjDA ARZNZjjzd91yYgQxlXNAsRwgFXJgJsG70wsXiUuOPdkAsXq5j2L++19+EWQbBdwLAx5XrYgA VS9YlIcDF3CE9VJgtBXbLGWZZQMHMMA6GP4mPbQpW7Qa5B0zYA4G2Tjapx5gAd4JAK06qdWe JoaUeomhHacWuBDMw5VDesZA9sS1pSKgqf3zrlRL5kurYjWHp92d/ppu10z5Fq48Ithw4E6g 3zonhMe+TMcMMywkApPzINZIIXAjMDGB1OIE0KucByBDWOJKTi+pQOXKTuNWvZDUIISgwOP2 YgIRZa9wntLFBKA3pAj05h2xczQ5wOeaBbhAKvFrzo4tXVJHHgSnVNOMA+hrGUS/MgxjMS5P LQrlD86jXzbQHNyolLfPQGMj9ekycLmrS3ogrnBV1ctVyatVekyChwqYUwwLko71lrFfMkht 4WzgKTu7+0J+OAMc2p0OeZ/hF+SAg7wFswl5I5Uhx7D3QBlSC3tXMd4s/YW8/1hwOIDjHfqG g1RSYe+In6HQBklHI+Q97wWdg3ubHcg6/moRcT+sih7niDccbDMfb8BB35VxKB7knZxQ6Hti +T4DHk7OkHNsHA6mYogu9B10gRxD341oiMqZQvIzjO5ZM4eD/ur98pP3Gw4EcvkZ/DCWn9vF GvImRENieoZnM0PeSRdIOPAAh2PQr4fNpAc4Iv50aEQcv+/Ou96TJA882GCvew88Td4Rhhwc oRbW2FOJBc/4xgPxHUMDETgcT3mQvOPtHuJquyvP+c77xQTAo8C4PE96cmsqeDpkaelXz3qR zGhGrY/962MT+9rb/va4z73ud8/73vt+73Hyhjfi/vviG1+tYUjBCnq3kPhaY/ikI4c1rJEW XayHocRR/hHi/u6VFHjfFQOTPvUH8w4ZKP/fMEn+8g9yBO/j7Vkz8L4LqkjunXlfBsf4IUHO EYYVpIDdGFEL/pcCRSIQ6ud9ypcCLdAXyCZ/M0MYyeJ9K5AKkzcQ4jcwg2cD30cTcKB8YUAp GfQQk7AeDEY6IVAABWAChqYYaaUWkAVWdRV5AuJRA7FoB0Bnd0EOylYoMzFSBiEPFEBXmzBF AoIB7UYOHaAy3+EBGDgQjSCDe5EDArFqhFMAHTB5IOhWi0EPqUCElRMFx6YW0FI3BWA4AyEC BXAAl6YWJxQAWDQTitUB67WGCtEqBkU6c3ghrlALLXEbXQSDFsg9DoABojRueZiD/qllHT1I awyxJzsRQMRFAYHDL+CgTXWTGk14Q/7RXQiAFTlQhMUSVTJAFxmAATy0AIqjL+ECGQXAgzRx DvoyiMXiQwJxMP90F1YEAG8oE3bSAR3AiDYgAt2SCiJgAts3W2E2AB7AcungByIgjDG3CcXo CtqQAgO1AiJgA4T3jBhXFiZgAs8oA55yBBXTadbwjN1yIY1QjCfQh/RQC8XYCOTQAsJIb2cA juDIdQLxgliDSgCAN6GQAQLJFOQIN502H9JYjCJwBGnxC88oj/SYAu3mDdjYArWwOzxIDlGk kI0wIXBQjDliAkQhD8EoArVgi3QIbZLkbXpxALrQdxiQ/gGq4jsCMgO1oAtBNiSKSBDO5QBN pU0E4kB+IA+TkBiyFRERsQ4ONDF7tll9Bxn3QhPaAD10VAsCmQFEEQblyBTvEArgWIw2kBbM UIwmF5H6M4/CWAviZSP3+IwmoI/WVow4cgJY4RjTGIcg2DmzpBeEyCEzQJSkEQA24DndNSQF cFWCEhkr0D+EMBsLUx/qkSXyIAOUAze9YYnVVQuRsYWbEISfUQAhQBRD5AAyyDT94pmZ0QFS 8YeYAw6phQAhsAl7NBDmljTW8A79EZgQgBVbsk36QkREwRqaMWJ6YR1jGJjnYi16kW6l8WiJ oQDFkpIR4ZmTVAuBwwDtyAwy/vKL3bM/bwQARlMQ1YMAhOAKEMMwbZIYdPl2HiYQrdIBGqFd /EIOVKMATfgS1eNXITAJsykQdmJWKuYauoYVmxAZCxBmD0QU5LBenvQ2WLQNYZYZTEgPyxUA LoAZqZBSmuEhqXGIHLMZgfNlW1U58ugNEDMANuAK/VMAtnFemuEHFSUg/TMkcEIOHiCHMlMf qnGcVyEPq7QY72SgGTBn8mBLJIQ/quVtvmgCrrAJxcJFifFiBpFT6fFBwwEtUaadzCCHsamW /kMPCFUy3AMAUZCeC0MBHlQofiCH1shPyWUtblULqfA2UqIZ0jlOKykPiqUZoEkUuUSmBHFe ESAY/gXhpk0SACWmiekxUwRhDSxUaL8AGQ6QCr+gTQhwny/xiVW6GYWWeHpxLHEihx6wCboQ eZNETUf6GYOZUwFgipKBRY0gh0y6CSzUaHWTCq7wOBCAoL5Ia/OwXh3wDlN1AEwRppcqVcAV CsxQoe4xJv7RAekVYsC2OkR0Et6AI07aMrPWQitYW3tWAL0RBnBDDkPUidagbGUaEdCAI1qU GBPGTD+4M6ipHuOyXp1jEziCB8ABAFzRKgdwDKgFR20YVXaVGIooD610Jm8TGinCVeyiWD7E P+7zg57JL+nwCykggzplDW2ImALBZFjDDOfZAR5QQAewCe9QShTQAUEY/gCXMhC2BJ4uwU/1 oxkKUIEXsgK+uLM827MtgDkIOwOaJhkIEBr0oDVH+Sw4QgjA8Vbkohi/AA67YwPrwFs/e64o thEhMwOaYRsI9kAewAxvt1Po06GJca+eSWfaRaxg+pyTx0ubmkNeg0kCgVyjRKFR2hAysEbp 8SQgeGk/ag2pEBxMMQmEa6T2uQ5mZg0esGmSAaU9hDXy8AuUew7MMAPFgieHmA6ItqiJ0a/B QQ6QJ7C7g0U6qBeFwgwZ4LigAac6NSFxxicCcYgYkRsBMEk38gvMQA66ADiRkQPvoE0ucCAV ejUFAR+9UwvecTbe0VVAqBeVsQ76MpiNugIh/iACjbBQA9OGQzZkXbU/zEC55AANf6ettogn l9e0hyptTOVUz/UOPCQfuYhFjPs2deO1SCQafOmf+ZGH18U1g7tdbctU1gZcqRAyhkQPICsQ s/FkFBplJAlc+2m7eMKdR6mZ3iogGSquAWCfRoqKN6QXUfAOewIBK9AIxWIdrCmeu2MdJNw8 9OC/o1E4JjA3erETYXqz8JsYR6C4ejG8dhUZJqeKLUAIgZMlDUsBZ7g3M6Ivd7onk2R9C2Ma 2qA5ASAfMlUANqALv5CTALCTAwEfYaARqQAZVwEZEZAcTlVUlsGCXfMLXBwbeMAeUXkhLnC9 eCwCeZzHMrAg+QkH/vNQtrJ7tDC8TAhQw6b6tNvVRN41ureLsKl1BhsDIidcLPhbrQLRsMjx wnfCnZeWttlFuG07JBPgB96AHgUgA7XQYh2AFc56Uww8RX+EYHDydhDgCiisrSCIABngDYEr vXCDAXNyQDGLij6sWrm4ArXAM+5qplJaEJpaAMCCSLMbHB2wDdyZAQU3J6DbwaLLW/KhSUlD AeqGB6frXbWAGK37dhhwErelU795p/WxEwFqPRmwOwqAFeBgbplxJ00IB6wYk8XSAibKVcBS Mp4yRFtodOMxAFcCGZ14F2EgIBlQmCxniweAldqEAbUwx0o1bfIwvVgFAANAzq+qOz88/k9d i7eY/I6BEzyuIZBnKxC2q7YtyRTkkx6DSQg+s6EtICaJUUx1a1Fe62jWpxn2+ySQRdLQELhc 2Bp8KpIFXFnswENlCllJQzgq7GgGQYUCykEnsdQF8AxG/JmSgcOhW7U8TA8LSrQYibeJkTKS gcT7uxFY7dCMiBFQ3FKE41cei4RKqIz36RgqoxdtlDc8VCnOQQ/1wQADAwpEqB7HqBbkYAJ9 zUETwqoBwAyoqhiaQWdexl2RUS1IuKGgg0VLLdfNTMsHwrUcgjR3Egbh8YZHEB44lgIn0AKr sgm4nQKj41vh4QIxFwq4DS824gK4jRWEgNvyIQ+6UNzWUNsK/pgcJBkeK0AO24DbonIhm2Dd i/3cJyAD6wAP8XcCE9OM4SEzLhAedDQJuB1MFiGA4WED1uASOGXd5CAP3Z0CYcAMNjDf73AM wc0O1Z0CRjtZKSDc+20a6QAH4TEJutAC4VEoeMDcGCHdrhArKbCLgWrbA/EO7s3eeGcjx4Dc 4Z1/CTG5/hcesmSB0n0CYUkQUTDhBrEN5ncCcDDiaqHi862d+5MDvZ3fqRAeR0C+AM4M4aHb CITbo0MOMnACwk3cJ8Am6VDhJ9AIEc7enhMeORCGESHbBh5oJ+Cxx1fmZn7maJ7mar7mbN7m bv7mcB7ncj7ndF7ndn7neJ7ner7n/p6HLuzA54Ce5vH1cniwCYRaZ6nwcqHBDC8FQTTBDOiU dgXxC+i0cieRKYSOqQuRb0CnfzXR0RgT6GeuXupWABDgivnlAUY5W5rRgiUx0dvEcwIhzpC2 j4c6eiFxWwWweYNRoeMm6sXnDU+FQQcAxmrVi2wdBsou6y/BwQxw6AOB1QGgiA6kF7gOEgF8 ADp+F6wN7MaXagWQAWFAQFy1KpMbBcrebtaA7rrADngQBXDAcy6H7u4IcVEwlJvAciAeBuge BT5+tImhGhqJ7ungFfx+8GcwIeSK7vBFELXA77VQU8jE7LReRvIQsJoxHOvQCP3e305I8NqS Dq7Qktvw/g5+gO5+sA5+wO/QhO54AA99FwZ+cA6pEAYSdxhcXRAb3/HP5p4EDw38/nR5E/Tp QAjwjh0nHwZ2cQz8PpQMfAYHb84EsQnojm9nEAUs51AcHwaE4OnAfg67IwITYndbJxhiu0Y3 JhBDhAEi8Dgz6TU8dEeC0cAQoJU+BNikgQDHiOx6MyRNrRsC0lTKEtVpkQqppQB7wgAUTxpp jFh1k3Wrmxl6X80BgAcQsBgj/x3GQJmVoyjwNJh5UTi+BDG83LSEdhDdzpOR7xoKIB+MPSQt wFsF0Du/wD3hThv26cjy4ezJkb0C+kDDoa/WzBztDKbCvJnZ4u0GEU16YRrW/nYEhncElQTV HhAG1IEAtmGklbNGfOUfUZQ0P0sOxWLG8mD9EJABZ5BTA3AMhPxPfXZSxwABDqBuJlMz1hMF kxMAYk8OnEg3+VsQACEjAIAABwKkmhEgw4CBrujlgAAhAxyBAApAo5eBYAGL1lINLJAwAIJN 9N5BGGiDHpyBDNKlYzAwgAMEBCOko5dTZ4uBFOTpzGkDgoMOcBJaxKiR4AKOABB4e0eB4AEH AwgqILcOAsEj9MIMdJBuXYiIK/AozQCPmYKBC2ISzEBPV4EAA2bY4DjhHFC+ff3+BRxY8GDC hQ3/ZSaTWU6lAQpYqxXA8SZyRwZmWDcI5KZaNQMc/kkXgaAMb52d/vLGFsAABybkyTvHjFll yQB00QsxsAO9YwQDWJu3jpyJgQgaydMYQIQ3ZgwsbmpUnPIJgmH7CgwQQQSAHBO4czxoMh0z aORsKM4IgCCDCd5c+eY4AE7Od6IDqGQZYMFL5wFSkNvEs0b6aoGgCX4C6p3xyrPBt8UwGCgC b85zzJuPLGokHReuygolAKLwCiyc3vHmGG2sgRCACOQ5agFmvKFgIAzoScEmb2CUrKvDduSx Rx9/DCwxglLJKYUFQPJIJgQUMMipcAjhUKuBooAJpAUQkMkPcBQYLZ136PGmhQUUUAA82+jx gKDdfpHJGnrgwQ6BSeiR/mcCkBTAMiU8lsLpKwCs42sG9SJwwbG6wqALgFrosWYFMtlCL7kJ wPkyFYIuDaCFn+pTT6U9AdivSgDOoIecBQjyg8CeENSp0UdrC2Cx5Eyg5z2LvNmkOG/oaUS9 Bchhx4GBuvLTuk0yUOBKmSZ4hycAfKKRIApwG2gAMmUKAUhtt+W225ykBMCDn9KBg6ABtrG0 riMIaYTdTeSBMgCs1nGAICr7M4HddhvxZsuB5qQnnRQX8MAGhs4MQU162FwNGnkKdaokOr1T qBGL2WXGj6vcFDQABta5bqAJfjnAJpIbSsfOPwuOlCARdLrQMY4QIMQk+1yQxzIAGDgHJq4Y /vUsVb4KDABanc6h2AGWCZJVPVo/KsiaUDZazM95twpABnnO+zOdUGoaAAIZOohQHmdvQlM9 DOQxoTp2317UW7nnpvsvPEAywQUTEn0MnJg+s1AGGW6L92r1opBnBYI8eIYZG1xI1RsBc9qm 5ACicLy229IMYLfeJMu8rRZkmIGcHAw8xpojZAhDHmZOVSgF1QAFCrsIrHkrBGjAc8Wag+Fg pmMAmlYOZnP9SPNZqOw74ATPQn0LgRUGxmjo4lpwQQYXgP8dmopiTS+Ap0G6EfYJxOTwHWGd cn69dY5YypVfpAqA2VDAC+EE8OIipK1avAmDDGzwpboV0IDdeocI/sx0lbq4CQ4cKQAC6IKB XRWuQz9jRr1GQhcFlCQ1/6IP2SyigIMFYFG5AcCaqsWMFMnkVjCaikEQQKqcwQpLXeuLoFT0 DsUFoBGVG0gtorIRBJSQeLTKyYUKgC7wrAAeUQBPAEJwKp75bCRWUZdfiHYpgmAgHfSLIBbB N6tabUQb9DhDCS+FlRrKxAQ1CcsvPHOAG6pIHu9IgQtlsrZ3oDCCBXHBAQU5SB/J4xcimAAF KACHUFAgA7uShy6OQIEJZMAPOKFHKijpAS+ZgJIDYhQhOkBJG+yKHucYJQXiRg9mpICSUYAD BhSZKhkoMpDWSCQGttECSioykR0gB5gm/hECSrYAGvPISc4oKYNaiIACIiAgUOCgyBTIIwyU /AU5MpDIY/AmBYkMwzQTOSBeTkAlOZkfBYApjzNQsgO1sCYlS+fJEPAnJTZQZyhYBZQo9DKR xeSNJydwBnFSgJyUzMHC3AkOOrmCmCtw1q/oNMkJ5MAbzjTBO+TRiAxQIASN4KU6d7UOP2wz CimKS8BCIVAT6AKZhIRpTAfzmtckc590qilQaGrTm+5UpznViU9p+hOavnSnQx3qT29qU576 JakmQZBPcRrVowK1qVfFaVNFRcOl6mQeSBVqTpMqVZ96wxovYidBIIDJrE41qDUdq1mZkQ55 cA6JWJVpXvW6X1e+9rWAVQrAfPQqD/0VIAJvJEgYtEWOCRSgABkIAUMK8Au/Vtayl8VsZvti RVLtNRwisByoBritWlDAKtUBpWZVu1rWtrZb8jhGLXRhjr66Trb/89Y7fnFbtrq2MAEBADs= } set image(logo) [image create photo] $image(logo) put { R0lGODdhwwAxAPcAAAAAAAAIAAgAAAgICBAAAAgQCBAICBAQEBAYECgAABgYGBggGCAgIDgA ADgIECAoIDgQGCgoKCgwKEAgIDAwMDA4MDgwMFgACGAACDg4ODhAOGgACGgIEFAwOEBAQEBI QEhAQFg4QEhISEhQSIAQGIAgKGhAQFBQUFBYUJAAEFhYWIgwOFhgWKAAEGBgYGBoYKAoMIBQ WLAQGGhoaGhwaLgIELAoMMAAELggMHBwcLA4QMAYKHhwcHB4cKhIUMAgMMgIGMAoMMgQGLg4 QMgQIIBwcMgYIMAoOMgYKMAwOLBIUKBYYMggKLhASHh4eMggMNAIGMgoMNAQGJBocNAQIMgo ONAYIMA4SHiAeMgwONAYKLhIUNAgKMBASMgwQNAgMNAoMMg4QNAoOLhQWKhgaMg4SMBIUNAw OICAgMhASNAwQNA4QLhYYMBQWICIgMhIUNA4SNBASNBAUMhQWLBocNBIUKhweIiIiNhASLBw cNBIWMBgaMhYYKh4eNhAUNBQWIiQiNhIULB4eMhgaNBYYNhQWJCQkKiAiNBgaMhocNhYYJCY kJiQkLh4gKCIkNBgcNhYaMB4eNBocNhgaMhweLiAiJiYmKiQkNhocLCIkMh4gLiIiKCYmJig mLiIkNhweNB4gKiYmMiAiLiQkMCIkKCgoOBweNCAiMCQkMiIkKCooKigoLiYmNCIiOB4gNiA iLCgoNCIkMCYmMiQmKioqLigoOCAiNCQmLCoqKiwqMCgoMiYoOCIkNCYmLioqNCYoLCwsMCo qMigqOCQmLiwsLC4sOCYmNigoMCwsOCYoNCoqNigqLi4uMiwsNCosOiYoNioqOCgqLjAuMC4 uNCwsNiosMi4uOCosMDAwNC4uOiosMjAwMDIwNi4uOCwuNDAwOC4uOiwuMjIyNjAwOi4uMjQ yNDIyOi4wNjIyNDQ0NDY0NjQ0PDAyODQ0NjY2OjQ0PDI0Njg2ODY2OjY2ODg4PDY2Ojg4ODo 4PDY4PDg4Ojo6PDo6P/o6PDw8P/w8P///ywAAAAAwwAxAAAI/gD/kTu3r5/BfwgTKlzIsKFD h/TEHXxIsaLFixgzatzIcaEpLYWMvdOnr1/Hk/3SOYmggl5JkydjypxJs2ZCTFCgUFkjCZq8 lzYb9nNHS4UCAABOpHMJM6jTp1Bn4swJRcoTPafGMW1aUx82NBkGIEUqQpw7plHTql0rdCrV nETO9Gxnb2LMfvRKnTg6dqwHbGbpcWVLuHDNfp+ovF385E+sbj/tZtQnDg0FsX3HDjjBDNvS wYZDi87YD9yjKkSALKaKpIykZe2AWhxKywWDzH0HRDhhqPPn0cCDW9Qnz5kmL0iAqF5N5Emd WOPsyWbo1QmFA7jHHsgww1ApYMzM/pYUTr58QrzuxCFr1OVJ6uWrvVDyOR0vMBGYsx9g4MGJ pVKl0BLeUvqYZ6Bw/ehDT3rYEOPJHlcwkdpqUAARBSGngCOPPfRsc8dl2QEwAH8u3PEfLcAA A9hZ4x2IEmguzqagO+mIgw0ztTSyxRFGwPcWEK39AcoeExgQ4gEsofFfgOABlg6LMF6kTzq1 uWAlGp5NhxCN4nRp1lDM5GBlDsy4o+V56TAzg5VWloKNYJLF+JBBM6ZT4zTEsBJJF0wI4eNq FyQggACaKcCdd0w2Kc6TW3XUz30H5IcUkmiYORE9GRygqaY5YCMCdtqVhdZ52LigAKiaHSBC KZZGKedC/gnWaSMzvlRiRhDKUUgVBgkQQIACIPCAKIqdLXpWox3pMwOq2W3GDFr03NaXCB6E +Neo/dzBV4giqkCgq68qROeCXE4DCxlTNHDBn4th4EAIUzBiCbFOQgnucDNwmxkFb5bkjrT6 9uVBmS/dway+KogzargyKpgOMGiEYKQACVyAAYXKAYGDEnZcgsuA9tLkBG4sqVBtZjkQmA7A AY81g3iGHBzwHd8yfBFeYUYgKQAEJKBuxj8qh0QXjQQTWIszpbMtUgrcAaAlJ48VATBLicNy qjIDwADV4lCAmwIinOCBzPz+ZvND+hBl285IEQABAx3ocMQOuS4GZBiJ/EIX/tIxlYLbCUvS YjDKZmFzdbdoWIbbAZZgU8rOA3RniSU57HxAKeJhVA854XjjzTXzGHSvUzijIcLSuRmaAyOc rJIJHU0EMaHdRFRByC2QnamRCLi5gMYdhlhiCOoZhMfM1QOoEHwphkSA2wzMqIBbBsvTQsvY m2p6h3iu1qNNIXF8sRgY0JA0Ok0plaICA2xPSkGJgacIjC+jjJFEjxgj4YUk1dAV580ZwM0A NnWqxTXueJk5gH+YdALcqOA+DvxPk4BRiskZInjhsRRD/EGOQohPV1CIBZTWko47hOVIu8nB sJqEjRa2ME95MMMPZrcYIkThD7eIzEb64bWWZWYA/r0BBuoOgIbvdEZ6mVEBLXiXRCMuyk6z KlbNFJIPWygGhDkRxZP4phB4+GMm+nBB+wCgAA/MwGkBopex3MHGGmFjGsjwBBuG0CeMhcEZ C7tZD32omSAOEQ0CWpQLHHg9B5Yig/RIJJfqlcd64GE1QKhCFiZpBCh4wWhngZE2rGAL0Z1E H1HrCwNUoKQ0KupJLCKJghbkRmLUohJbCIIQVvOEXUzxZqFECgU84AERhO0EvqSWB07gJiH+ 0AW08Aw2cgkAZDJRYIckUCnQ4IQc5GAGZBohQvyhh7e0phGewAUwcMEGMzQCFisSDEMcCYVH qPJ8DMGUADOgQglKMZVc/hnXIomxiTEggZaoCAw8/9EPQ+BGBNWTn/UABB5xMAN1ADhADqz3 TO0AEg2WQ0MGseG8zFhCm/8IxxWRwAZWyC9F4EyRbzS4EFvoBBqJfAk78MEQfkTDFJ5MiDv2 2BcFvM9pK0UWQ8a1jmzMog2oWc0ONsEMs90MGwfbDPAscQc2sekOgHlosxQAUTIaghalOJwC XLAmiEYAG9r0RyFyEgZZyI8ZnYGjC42Vx5AqBhHrOJY+hgEFPNTlIPyYBBQUURC7uAM/KDzB HajWKor4Ix/eAEUdokAESAIhCJnIYIEmM8gfcrWAfTkAVtN0uICtCjyV4yNSTuCZUe1DDVCo /sM0mKFSJ6GSjXodjFqh8IVs2Oks84ADFOIwj3d+AgpyaIdLkKYP9bEvRCMSgRNo0dgNviMZ mFCDFjAGhB3ogAywaKo6J5OOBvJxYIsynGoBEAFAdgYbMxgjbjyQzC3ChJtQSAMqTNrQ2yZy uf8jh2IkUSNGBVcKw6AHNeQABzhsFwyEyOt4CTolWszgOtw6AAWU+Jn77gMerggEF7hLhCAo oQ+MCGQmNZIgcSBWXwPwQOOeZLWvHckF3/FMjeIbsAFQT8WbRcg7hAsF/XnBC2FYQ4PhQIif cBEh/VhrHLbRJfu+Q0PUAEMNRbEolyjEYY5Dwwme26wISBcYZ0FH/jImAQcrYIwIP2hCHg7B iQD5pq7DiciH2DaAAbwvmYGpcWhdoLPcRCAH8/LMWdJjCA/0WYAR6E6OnfoPfaADFGEIA5LX 8MGcxGEdC+NHMvAwiWhQQQoBpes7vIEOeoxDDKvpwoC8fB6H2QgYhlABhkPkU7KaAAYyeHMS xiCIUKzCev3Fs4zokSZDnCAD0M5Af5yWonQKWjtOQEMOPADt/nhHRUcDsyXQwO1oz6CUAmot 39ADxWbsIhJXfMIttKkN2OZkxHOYxhPd8QrxfcIdvYhDGP75BC90IbxdHkyCWDkrWpBbAWPs swA20IIaAA1IQ6DDJVZx7FOGjCMLrxFt/oFhPWSf0iUrS+ACmYTslb5k4QyibclN7qS6Lnwc t3jDE6CQBS8kYhbNYFRJ9oGJ7d67yLpw0jpeoRgtVMNO6WhGFJhQC5KryL5DhbkbsSE4FRRa XxuoQQ1kYAMf2MERprynUB0lqxbCda5CT8nViMik97bQWEjTuo1u9HZGPrkf8+h3kdNAimnA nUX2gARVxKCJREChDVLsxgclYQ47mWMQUNgDMVR6tCjRSVbTuEQMSsABH5JgBUUIHrHouva7 wJxGUEdlo/6VwDugyLay56I+YQ91NrYeIeeIAxS0gIhmuPDw9JCH4qEghlNYAxlPQAIrfIMO 4UOB8r8FBRSY/qALuCLyyVlXEDpuMQYbyKAFKWjBBgKmAAu4YF4gMx9UPv/f5U6H9qFd7IpU aT5X0T+m/ecQz6AYX6AMsRd7bPQL8nAMihEH39AgZQAFV9Ak6SB57eQl6aAMWjYIc5VJ8JQP 7GAMhAAG7wEENwAENaB+AaNhM2AJ4gV+pJNTDIF/2qF/LLVD/8MQAwgFhNANvXcsibSAhSAP hAAFYJAN6pEGFSII4PYN2vcH5uAlpwBbVJAKXvINcGIR/oAP2oAJccAFUmBZMgADK2ABEZA1 k7IbGvV7oUGDk9IbmaMW+QBrcoAOCAiA9oATZ9AOfwAFlLAN05AGRDAEQDAKnWEN/nWACDy4 d4mgBqBABVFgDV3yC3VQFxXBD+fAC4ogBkYHSd61BH3gCMIzAx7QVUgxAIYyA6WQDrpTGPSg AtBGAREQARngJpQGFXxFBb1QI3Q1dNfgBznxb4ooCqSAGo2QBUCACtjQDGVACNr3BJWwCWVA BIPwBkg3DXzwBK3wVw6RD9owCWegBVcEST/AMXVmcilSVV/XLPyBVcq2FgnCIFaHSAPFEf4g XKh2dwSiD79IFV9ADemgC81BBETQCMSQBflFCVEwB99ADUxAFUCwB8LwT1DwBFXwBJpwS9sU goHwBeO4GEKABBmHdnU3V25XCk6QARCXYRQwUdVFGDA3/ivpBIM1cY85YQRzQAqosAu9oAdr EIY5QQV/KA7TEAZQQASicCMImRNvoG/fEIE5MQjTEAwUyXO1oG5cwQ6msAadSDtHsAUdk3b1 glu8yHV3cAK7xo6A847zVye/xZaHsVZYlBP6pW9dMgtzIAxdgg3WSAR8oG92Qg1vkAap0ELb gHlCsAe+MJNc4Qof+SMiSQZ90DpqxCj2t0qLxAyGsG2mKCIioJHwSBL/FYBr8Q7WpytlQApv 90S/BUXWIAtGU2W85yXisA2yIAsdqCVuAZFwxjGMkChqpyX6tHVdt459kQFoRWuGITo5GBX6 MA51UFk5EUleMAiy4H1j+V9k63mAx9JGB7goVVZXu4lxbEBnJcl6rQhlopmZpcCZkkIBmlWP ZzMnzCYMqOAJmzAKxICd+phK/Fd/uGV/9adIuAVSUDYVRPCVkymWvdic4cdwDoVrXgcqFHB1 Ezafd2FrfNd3fsecHsp//fehICp/sFJ0aRAJsEALHad2bNgwDHcjtJCS22Gh8omhQtF2gLFv LQplMugQzOmj17AMDzhywemgpKF3t2YIWCJQNoo+61mgAFajMtF26GmkbCcrsgmXTXqk/Nej ofF6vpeeNrF7YSqlWzqfn/dOZnqlanqmbooRPxoccfqmdNoQAQEAOw== } # setPrefix # set the platform prefix # proc setPrefix { } { global platform global tcl_platform global urlbase global report_url global proxyhost proxyport # configure proxy if needed if { [info exists proxyhost] && [info exists proxyport] && \ ($proxyhost != "") && ($proxyport != "") } { ::http::config -proxyhost $proxyhost -proxyport $proxyport } # osVersion platform machine os puts "Formatting query" set query [ ::http::formatQuery \ osVersion $tcl_platform(osVersion) \ platform $tcl_platform(platform) \ machine $tcl_platform(machine) \ os $tcl_platform(os) ] puts "Getting: $urlbase/prefix.cgi $query" flush stdout set token [ ::http::geturl "$urlbase/prefix.cgi" -query $query ] set data [ ::http::data $token ] upvar #0 $token state switch -exact -- $state(status) { "ok" { } "error" { error "Error in transaction: $state(error)" } "reset" { } "timeout" { error "Error in transaction: Timeout" } "" { # oops. in progress? } } if {![regexp -- {^(HTTP[0-9/.]+ )?([0-9]+) (.*)} \ $state(http) all prot code msg]} { error "Failed to extract status code from $state(http)" } if { $code != 200 } { error "Failed to retrieve platform prefix" } puts $data set platform [string trim $data] if { $platform == "unknown" } { set msg "The upgrade script could not determine the correct\ platform.\n\ \nPlease submit a bug report at\n\ \n$report_url\n\ \nand be sure to include the following information\n\ \nos: $tcl_platform(os) osVersion: $tcl_platform(osVersion)\ machine: $tcl_platform(machine) platform:\ $tcl_platform(platform)" MessageDlg .msg \ -title "Unknown Platform"\ -justify left \ -parent . \ -icon error \ -type ok \ -message $msg exit } return $platform } # mkabs -- # turn a file name into an absolute path name proc mkabs { path } { switch -- [ file pathtype $path ] { "absolute" { # how nice... return $path } "relative" { } "volumerelative" { error "Can't handle volume relative paths" } } return [file join "[pwd]" "$path"] } # mktemp -- # create a filename for a temporary file # proc mktemp { } { global tcl_platform global env global tempdir global instdir global version if { $tempdir == "" } { set tempdir [ file join $instdir "lib/epcEdit-$version/upgrade/tmp" ] puts "Temporary directory: $tempdir" if { ! [ file exists $tempdir ] } { file mkdir $tempdir } } set now [ clock seconds ] set tfile [ file join $tempdir "epcu$now.tmp" ] set count 1 while { [ file exists $tfile ] } { set tfile [ file join $tempdir "epcu$now$count.tmp" ] incr count } return $tfile } # mkBakDir -- # make a backup directory for this installation proc mkBakDir { } { global instdir global bakdir global version set dirname "upgrade-[ clock seconds ]" set bakdir [ file join $instdir "lib/epcEdit-$version/upgrade/$dirname" ] file mkdir $bakdir } # getInstDir -- # get the installation directory. This depends on the platform and # on some user-defined settings. proc getInstDir { } { global tcl_platform global scriptdir global instdir set sname [ info script ] set scriptdir [mkabs [ file dirname "$sname" ] ] set instdir [mkabs [ file join "$scriptdir" ../.. ] ] lappend auto_path [ file join "$instdir" lib ] } # getPatchLevel -- # extract the current patchlevel from the file patchlevel.tcl that must # reside in the same directory as this script. Default to version 1.2 # and patchlevel 0 if not found. # # This proc set the global variables version, patchlevel, and instdir to # the values from the patchlevel.tcl file. # proc getPatchLevel { } { global version global patchlevel global instdir global auto_path global magic global defmagic global scriptdir global maxlevel global proxyhost global proxyport set magic 0 set levelinfo [ file join "$scriptdir" patchlevel.tcl ] if { [ file exists "$levelinfo" ] } { if { ! [ file readable "$levelinfo" ] } { # error. must be able to read that file } if { ! [ file writable "$levelinfo" ] } { # error. must be able to overwrite that file } if { [ catch { source "$levelinfo" } msg ] } { # error. must be able to source that file } if { $magic != $defmagic } { #error. Invalid magic value } } else { set mustHave [ file join "$scriptdir" epcMain.tcl ] if { ! [ file exists "$mustHave" ] } { # error. Not run from the lib directory. set msg "Required file(s) not found.\n\ \nIs this script located in the epcEdit library directory?" error $msg } if { ! [ file writable "$scriptdir" ] } { # error. must be able to create patchlevel file } set magic $defmagic } set maxlevel $patchlevel } # setPatchLevel -- # save the new patchlevel to the file patchlevel.tcl that must # reside in the samedirectory as this script. # This proc uses the global variables version, patchlevel, and instdir. # proc setPatchLevel { } { global version global patchlevel global instdir global defmagic global maxlevel global proxyhost global proxyport set sname [ info script ] set scriptdir [ file dirname "$sname" ] set levelinfo [ file join "$scriptdir" patchlevel.tcl ] set handle [open $levelinfo w] puts $handle "# patchlevel.tcl -- maintained by $sname" puts $handle "# -- DO NOT EDIT THIS FILE --" puts $handle "global version" puts $handle "global patchlevel" puts $handle "global magic" if { [info exists proxyhost] && [info exists proxyport] } { puts $handle "global proxyhost" puts $handle "global proxyport" puts $handle "set proxyhost $proxyhost" puts $handle "set proxyport $proxyport" } # puts $handle "global instdir" puts $handle "set version $version" puts $handle "set patchlevel $maxlevel" puts $handle "set magic $defmagic" # puts $handle "set instdir $instdir" puts $handle "# EOF -- patchlevel.tcl" close $handle } # testURL # test if a URL can be retrieved. Returns the size of the data # or -1 if URL can not be fetched. proc testURL { url } { global tstate set tstate "Connecting..." set token [ ::http::geturl $url -validate 1 ] upvar #0 $token state switch -exact -- $state(status) { "ok" { } "error" { error "Error in transaction: $state(error)" } "reset" { } "timeout" { error "Error in transaction: Timeout" } "" { # oops. in progress? } } if {![regexp -- {^(HTTP[0-9/.]+ )?([0-9]+) ?(.*)} \ $state(http) all prot code msg]} { error "Failed to extract status code from $state(http)" } if { $code != 200 } { return -1 } return $state(totalsize) } # # fetchURL # fetch a URL into an open TCL channel # proc fetchURL { url channel } { global tstate set tstate "Connecting..." set token [ ::http::geturl $url -validate 1 ] upvar #0 $token state switch -exact -- $state(status) { "ok" { } "error" { error "Error in transaction: $state(error)" } "reset" { } "timeout" { error "Error in transaction: Timeout" } "" { # oops. in progress? } } if {![regexp -- {^(HTTP[0-9/.]+ )?([0-9]+) (.*)} \ $state(http) all prot code msg]} { error "Failed to extract status code from $state(http)" } if { $code != 200 } { error "Error in transaction: $code $msg $url" } puts "http code: $state(http)" puts "[ array get state ]" set tstate "Retrieving file..." set token [ ::http::geturl $url -channel $channel -progress progress ] puts "http status: $state(status)" puts "http code: $state(http)" puts "http meta: $state(meta)" switch -exact -- $state(status) { "ok" { } "error" { error "Error in transaction: $state(error)" } "reset" { } "timeout" { error "Error in transaction: Timeout" } "" { # oops. in progress? } } if {![regexp -- {^HTTP[0-9/.]+ ([0-9]+) (.*)} $state(http) all code msg]} { error "Failed to extract status code from $state(http)" } if { $code != 200 } { error "Error in transaction: $code $msg $url" } } # readMap -- # fetch the upgrade map from the server into a temporary file and # process its content. Calculate initial transmission rate on the # fly while fetching the file. proc readMap { } { global version global urlbase global transrate # get a temporary file name, compute the name of the map to # fetch, and retrieve it from the server. set mapfile [ mktemp ] set mapurl "$urlbase/upgrade-$version" set chan [ open $mapfile "w" ] set start [ clock seconds ] set tm [ time "fetchURL $mapurl $chan" ] set end [ clock seconds ] close $chan # compute the initial transfer rate (used for guessing how long # the upgrade will take). puts "$tm" if { [ regexp -- {^([0-9]+)} $tm all ms ] } { set ttime [ expr $ms / 10000000.0 ] puts "Transfer time: $ttime (seconds)" } else { set ttime [ expr (($end - $start) + 1) ] puts "Transfer time: $ttime (seconds)" } set transrate [ expr [ file size $mapfile ] / $ttime ] puts "Transfer rate: $transrate bytes per second" # process the contents of the map file, then delete the temporary file. processMap $mapfile file delete $mapfile } # progress -- # update progress information for a download. proc progress { token total current } { global totalTransferred lastCurr if { [info exists lastCurr] && ($current > $lastCurr) } { set increment [expr $current - $lastCurr] incr totalTransferred $increment } else { #set totalTransferred $current } set lastCurr $current } # processMap -- # process an upgrade map. # proc processMap { filename } { set chan [ open $filename ] gets $chan line while { ! [ eof $chan ] } { switch -regexp -- $line { {^\s*[;#]} { # comment gets $chan line continue } {^\s*$} { # empty line gets $chan line continue } {^\s*\[.*\]} { # section header processSection line $chan } default { # unknown line. gets $chan line } } } close $chan } # processSection -- # process a section from the upgrade map. # proc processSection { lineVar channel } { global version global patchlevel global maxlevel upvar $lineVar line if { ! [ regexp {^\[(\d+\.\d+)\.(\d+)\]} $line all pversion level ] } { error "Invalid section header $line" } if { $pversion != $version } { # should not happen ignoreSection line $channel return } if { $level <= $patchlevel } { # not relevant for us ignoreSection line $channel return } if { $level >= $maxlevel } { set maxlevel $level } # continue scanning input file while { [ gets $channel line] >= 0 } { switch -regexp -- $line { {^\s*[;#]} { # comment, ignore continue } {^\s*$} { # empty line, ignore continue } {^\s*\[.*\]} { # next section header. return, leaving # current line in buffer. return } {(?i)^\s*Content\s*=} { # file statement. processContent $line $level continue } {(?i)^\s*File\s*=} { # file statement. processFile $line $level continue } default { # unknown line. } } } } # ignoreSection -- # read everything up to the next section header proc ignoreSection { lineVar channel } { upvar $lineVar line while { [ gets $channel line] >= 0 } { if { [ regexp -- {^\s*\[.*\]} $line ] } { return } } } # processContent -- # process a Conten statement in a section describing patchlevel # level. Stores the content description in contents($level). # proc processContent { line level } { global contents if { ! [ regexp -nocase {^\s*Content\s*=\s*(.*)} $line all content ] } { error "Invalid \"Content\" statement $line" } set contents($level) $content } # processFile -- # process a File statement in a section. Adds the file to # the global file list if it matches the platform or has a # "generic" prefix. # proc processFile { line level } { global platform global filelist global perms if { ! [ regexp -nocase {^\s*File\s*=\s*(\d+)\s+(.*)} $line \ all fperm filename ] } { error "Invalid \"File\" statement $line" } set filename [ string trim $filename ] set prefix [ lindex [ file split $filename ] 0 ] if { ($prefix == "generic") || ($prefix == $platform) } { set filelist($filename) $level set perms($filename) $fperm } } # processScript -- # process a Script statement in a section. Adds the script to # the global script list if it matches the platform or has a # "generic" prefix. # proc processScript { line } { global platform global scriptlist if { ! [ regexp -nocase {^\s*File\s*=\s*(.*)} $line all filename ] } { error "Invalid \"Script\" statement $line" } set filename [ string trim $filename ] set prefix [ lindex [ file split $filename ] 0 ] if { ($prefix == "generic") || ($prefix == $platform) } { lappend scriptlist $filename } } # getFiles -- # processes the list of file extracted from the upgrade map. # proc getFiles { } { global filelist global tmpfiles global urlbase global currentFile global totalsize global totalTransferred set total [llength [ array names filelist ]] set fno 0 set totalTransferred 0 ProgressDlg .progress \ -parent . \ -title "File transfer"\ -width 40\ -textvariable currentFile \ -maximum $totalsize \ -variable totalTransferred \ -command abortTransfer \ -stop "Abort" foreach file [ array names filelist ] { incr fno set currentFile "Transferring file [file tail $file] ($fno of $total)" set url "$urlbase/$file" set tfile [ mktemp ] set tmpfiles($file) $tfile set chan [ open $tfile w ] fconfigure $chan -translation binary puts -nonewline "Retrieving $url..." fetchURL $url $chan puts "done" close $chan } after 1000 destroy .progress } proc abortTransfer { } { set msg "Really abort the upgrade process?" if { [ MessageDlg .msg \ -justify left \ -parent . \ -type yesno \ -default 1 \ -message $msg ] != 0 } { return } exit } # checkFiles -- # this proc checks that all files that should be transferred actually # exist on the file server, that they can be created or overwritten # in the installation tree, and that any required directories do exist # or can be created. # It signals an error if these requirements are not met. proc checkFiles { } { global filelist global urlbase global filesize global totalsize global instdir global dirlist global effname set totalsize 0 foreach file [ array names filelist ] { # check if the file is available for download. set url "$urlbase/$file" set size [ testURL $url ] if { $size < 0 } { error "Invalid URL $url in upgrade map" } set filesize($file) $size incr totalsize $size # compute the effective file name set effname($file) "$instdir" foreach prefix [lrange [ file split $file ] 1 end] { set effname($file) [ file join $effname($file) $prefix ] } puts "$file -> $effname($file)" if { [ file exists "$effname($file)" ] } { # file exists, so it must be writable if { ! [ file writable "$effname($file)" ] } { error "Can't overwrite existing file $effname($file)" } } else { # file does not exist. Retrieve directory name # for this file. set dirname [file dirname "$effname($file)" ] if { [ file exists "$dirname" ] } { # directory exists. Check if it is a writable directory if { ! [ file isdirectory "$dirname" ] } { error "$dirname is not a directory" } if { ! [ file writable "$dirname" ] } { error "Directory $dirname is not writable" } } else { # directory does not exists. Remember that we # have to create it. lappend dirlist "$dirname" # Check if the directory can be # created by reducing the path and testing the # writability of each directory. set pdir [file dirname "$dirname"] while { 1 } { if { [ file exists "$pdir"] } { if { ! [ file isdirectory "$pdir" ] } { error "$dirname is not a directory" } if { ! [ file writable "$pdir" ] } { error "Directory $dirname is not writable" } break } else { set pdir [file dirname "$pdir" ] } } ;# while 1 } ;# directory does not exist } ;# file does not exist } ; # foreach } proc transtime { bytes } { global transrate return [ expr $bytes / $transrate ] } # copyFiles -- # copy the temporary files to their final destination and remove # temporary stuff. proc copyFiles { } { global filelist global totalsize global transrate global dirlist global effname global currentAction global tmpfiles global bakdir global tcl_platform global perms set currentAction "Creating directories" ; update foreach dir $dirlist { file mkdir "$dir" } set currentAction "Installing files" ; update foreach file [ array names filelist ] { set src $tmpfiles($file) set target $effname($file) if { $bakdir != "" } { puts "Copying file $target to $bakdir" catch { file copy "$target" "$bakdir" } } # I wish Tcl had a do-loop. sigh.... set retry 1 while { $retry } { set retry 0 puts "Copy $src to $target" if { [catch { file copy -force -- "$src" "$target" } errmsg ] } { set msg "The upgrade utility failed to copy the file\ \"$src\" from the \ temporary directory to its final destination\ \"$target\".\n\n\ Reason: $errmsg\n\n\ An instance of epcEdit may be running on your system.\ Please terminate all epcEdit sessions and restart the\ upgrade process.\n\ Continue the installation process?" if { [ MessageDlg .msg \ -justify left \ -parent . \ -type retrycancel \ -icon error \ -title "Failed to copy file" \ -message $msg ] != 0 } { exit 0 } set retry 1 } } if { $tcl_platform(platform)=="unix" } { # mostly needed to flag files as executable under unix, # windows uses the extension for detecting executables. file attributes "$target" -permissions $perms($file) } # now delete the temporary file. file delete "$src" } } # checkLock -- # this functions tests the existence of an upgrade.lock file on # the server. Such files are created while new upgrades are installed # on the server and removed after the installation has been completed. # Testing for the exsitence of such files prevents this script from # downloading incomplete upgrade data. proc checkLock { } { global urlbase if { [ testURL "$urlbase/upgrade.lock" ] >= 0 } { return 0 } return 1 } # patchLoader -- # this is a special hack for unix systems in release 0.92.0 where the # ecpedit script in the bin directory gets replaced by a shell script # that starts the real application epcedit.tcl in the lib/epcEdit-0.92 # directory. # # To stabilize the startup sequence, this script set environment # variables for different paths, provides information about the location # of shared libraries, etc. To be able to move the startup script freely # in the directory hierarchy, the initial setting for the environment # variable INSTDIR int his script needs to be set to the directory in # which epcedit has been installed. # # This procedure patches the loader script by inserting the approriate # value in the script, replacing the string INSTDIR= with the correct # setting. proc patchLoader { } { global instdir global tcl_platform if { [ string compare $tcl_platform(platform) "unix" ] == 0 } { set loader [ file join $instdir "bin" "epcedit" ] set hdl [ open $loader ] set contents [ read $hdl ] close $hdl regsub -- {INSTDIR=""} $contents "INSTDIR=$instdir" ncontents set hdl [ open $loader "w" ] puts -nonewline $hdl $ncontents close $hdl } } # # main -- # the main function of this script. proc main { } { global version global patchlevel global maxlevel global instdir global filelist global totalsize global transrate global dirlist global effname global scriptdir global currentAction global bakdir global image puts "[info nameofexecutable]" getInstDir getPatchLevel wm title . "epcEdit Upgrade Utility" . configure -bg white label .l1 -image $image(logo) -bg white -bd 10 label .l2 -image $image(titleSGML) -bg white -bd 10 grid .l1 -row 0 -column 0 grid .l2 -row 1 -column 0 label .l0 -textvariable currentAction -bg white -fg ForestGreen grid .l0 -row 2 -column 0 -sticky w update package require BWidget option add *font {Helvetica -12} startupFile option add *Dialog.msg*padX 20 startupFile option add *Dialog.msg*padY 20 startupFile set msg "This program will check the epcEdit web server\ for available upgrades.\n\n\ It will inform you about the availability of upgrades,\ the number of files to download,\n\ and the estimated download time for these files.\n\ \nThe program will ask for your confirmation before\ actually downloading and installing any files.\n\ \nDo you wish to continue?" if { [ MessageDlg .msg \ -justify left \ -parent . \ -type yesno \ -message $msg ] != 0 } { exit } set currentAction "Retrieving platform prefix" ; update set prefix [ setPrefix ] set currentAction "Retrieving upgrade information" ; update puts "Version......: $version" puts "Patchlevel...: $version.$patchlevel" puts "Directory....: $instdir" puts "Prefix.......: $prefix" if { ! [ checkLock ] } { set msg "There exists an upgrade lock on the epcEdit web server\n\ \nThis means that a new upgrade is currently being\ installed on the server.\n\ \nPlease retry the upgrade later." MessageDlg .msg \ -justify left \ -parent . \ -type ok \ -message $msg exit } readMap if { $maxlevel <= $patchlevel } { set msg "There are no new upgrades available" MessageDlg .msg \ -justify left \ -parent . \ -type ok \ -message $msg exit } set msg "You are current running epcEdit $version.$patchlevel.\n\ \nAn upgrade to version $version.$maxlevel is available.\n\ \nThe next step will check that all required files can be\ properly installed.\n\ \nDo you wish to continue?" if { [ MessageDlg .msg \ -justify left \ -parent . \ -type yesno \ -message $msg ] != 0 } { exit } puts [ array get filelist ] set currentAction "Checking file accessability" ; update checkFiles set msg "This upgrade will install [llength [ array names filelist ]]\ file(s) with a total size of $totalsize bytes on your system.\n\ \nEstimated download time is\ [expr int([ transtime $totalsize])]\ seconds.\n\ \nDo you wish to continue?" if { [ MessageDlg .msg \ -justify left \ -parent . \ -type yesno \ -message $msg ] != 0 } { exit } puts [ array get effname ] puts "Total size of this upgrade in bytes...: $totalsize" puts "Estimated time required...............: [ transtime $totalsize]" puts "Will create directories: $dirlist" set currentAction "Downloading files" ; update getFiles set msg "The required files have been transferred\ and are ready for installation\n\ \nDo you wish to continue?" if { [ MessageDlg .msg \ -justify left \ -parent . \ -type yesno \ -message $msg ] != 0 } { exit } set msg "This program can create backup copies of all\ files that will be replaced during the upgrade.\n\ \nDo you want to create backup copies?" if { [ MessageDlg .msg \ -justify left \ -parent . \ -type yesno \ -message $msg ] == 0 } { mkBakDir } if { $bakdir != "" } { set msg "Backup copies will be created in the directory\n\ \n$bakdir\n\n" MessageDlg .msg \ -justify left \ -parent . \ -type ok \ -message $msg } set currentAction "Installing files" ; update copyFiles setPatchLevel # patch the loader script for realease 0.92.0 if { $patchlevel == 0 } { set currentAction "Patching loader script" ; update patchLoader } set currentAction "Completed" ; update set msg "Upgrade complete." MessageDlg .msg \ -justify left \ -parent . \ -type ok \ -message $msg exit } if { [ catch { main } msg ] } { tk_messageBox -title "Error" -icon error -type ok \ -message $msg exit } # # eof: $Id: upgrade.tcl,v 1.5 2002/09/23 19:39:59 epccvs Exp $ #