# ------------------------------------------------------------ # Copyright (c) 2014-2021 # Q.W.Page Associates Inc. # www.qwpage.com # All rights reserved. # ------------------------------------------------------------ /* { 2.34.0 - use call/return and blue progress instead of read progress. - this allows server to keep working and not appear busy to other users This code runs on the client side but it is first downloaded to the client from the server. Server has the workstation serial info and upgrade dates and needs to look up serial to determine if download is allowed. We connect to an auto_update_server. For now we will connect on given server/port but later we will multiplex on the workstation/server connection. Each server will "be" an auto_update_server. We download into a temporary file in the temp folder and then rename the file to _client_side_file_path. Even though we could try to delete the file on any abort/failure, there are cases we can't control such as a workstation crash. We use the install.exe if it exists, instead of downloading, so it is absolutely essential that the install.exe is all there, or nothing. BE VERY CAREFUL IF YOU CHANGE THIS CODE It must be able to run on old versions of nv2, (2.34.0 or later). For example there is none of the newer qw::verbose elements. Don't use any qw::control flags if they don't exist in 2.34.0. */ } ::itcl::class ${::qw::script::namespace}::auto_update_workstation_from_server { protected variable _plug ""; protected variable _workstation_database ""; protected variable _server_information ""; protected variable _client_side_copied_megabyte_count 0; protected variable _server_side_file_size_megabytes 0; protected variable _operation_id ""; protected variable _server_side_file_path ""; protected variable _server_side_file_size ""; protected variable _server_side_file_mtime ""; protected variable _server_side_file_atime ""; protected variable _server_side_file_sender ""; protected variable _client_side_file_path ""; protected variable _client_side_file_name ""; protected variable _client_side_file_handle ""; protected variable _client_side_temp_file_path ""; protected variable _chunk_size [::expr {1024*1024}]; protected variable _start_seconds ""; method main {sargs} { /* { Usage ::qw::script::source .../auto_update_workstation_from_server.qw_script \ .server_information $ServerInformation \ .plug $Plug \ ; Not called if workstation release equals server release. The server information gives us the server's version information, which we use to determine what to do and also what to name the downloaded file. We use the plug to make rpc calls on the server and we are also given the plug's channel to use directly for the file transfer. The channel options are changed to binary, blocking, etc, and restored before we return. Note that we are called before the channel upgrades to tls. I don't know what effect the upgrade has on the channel but we can test that later. For now we will do our work on the pre-tls channel. In fact, whether we succeed or not, the channel is going to get closed. If we succeed we will install and restart. If we fail we will kill the connection. We can use $_plug cpp_tcp_call to communicate with the server. The application database is actually optional because we may be called to get the directories list and in that case there is no application database. But we need the application database, and the workstation database, because we want to skip them at crucial moments during prior to shutdown. For example, we need to commit application databases prior to shutdown and restart but we can't commit the database that we are trying to connect. */ } # ------------------------------------------------------------ # Downloaded from service hub, then executed on workstation. # ------------------------------------------------------------ ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,auto_update_workstation_from_server,main,1000.0,sargs==\n[::sargs::format .structure $sargs]";} /* { rwb1_debug,auto_update_workstation_from_server,main,1000.0,sargs== .server_information { .system_is_broken 0 .version 2.38 .patch_level 1 .build 20240112 .release 2.38.1.20240112 .sub_product nv2 .registration { .warning1 {**************************** WARNING ***************************} .warning2 {Uncontrolled changes to this file will render NewViews unusable.} .warning3 {**************************** WARNING ***************************} .serial INTERNAL-BENN-5 .nic F4-6D-04-61-A5-CE .date 20111202 .checksum 5AF32499C6E218B32653EA605F5E8ADD .customer_number INTERNAL-BENN .maximum_connection_count 5 .nv2_upgrades_expiry_date 20191231 .nv3_release 2.32.3_alpha.20180504 .latest_release 2.34.2_alpha.20200320 } .serial INTERNAL-BENN-5 .server_is_busy 0 .customer_support_registration_record { .nv2_serial_number INTERNAL-BENN-5 .nv2_upgrades_expiry_date 20361231 .customer_number INTERNAL-BENN .customer_description {Q.W.Page Associates Inc.} } .customer_name INTERNAL-BENN .osVersion 4.4.0-210-generic .pointerSize 4 .byteOrder littleEndian .threaded 1 .machine x86_64 .platform unix .pathSeparator : .os Linux .engine Tcl .user benn .wordSize 4 .server_type service_hub } .plug ::qw::cpp::F46D0461A5CE_13376_44 .release 2.38.0.20231227 .version 2.38 .patch_level 0 .build 20231227 .app_name app_name_workstation .script { .source {... this script ...} .namespace_id 8 .namespace ::qw::script::8 } */ } ::set _plug [::sargs::get $sargs .plug]; ::if {$_plug eq ""} { ::qw::bug 314120150212134400 "[::qw::methodname] - no .plug argument."; } ::set _server_information [::sargs::get $sargs .server_information]; ::if {$_server_information eq ""} { ::qw::bug 314120150212134403 "[::qw::methodname] - no .server_information argument."; } ::set _workstation_database [[::qw::system] cpp_find_workstation_database] ::if {$_workstation_database eq ""} { ::qw::bug 314120150220133704 "[::qw::methodname] - can't find workstation."; } ::if {![::qw::command_exists $_workstation_database]} { ::qw::bug 314120150220133704 "[::qw::methodname] - can't find workstation command."; } check_sub_product_compatibility $sargs; /* { Just setting local variables to make everything obvious and make their usage easier in help. */ } ::set ServerVersion [::sargs::get $_server_information .version]; ::set ServerPatchLevel [::sargs::get $_server_information .patch_level]; ::set ServerRelease [::sargs::get $_server_information .release]; ::set ServerBuild [::sargs::get $_server_information .build]; ::set WorkstationVersion $::qw_version; ::set WorkstationPatchLevel $::qw_patch_level; ::set WorkstationRelease $::qw_release; ::set WorkstationBuild $::qw_build; ::if {$rwb1_debug} { ::puts "rwb1_debug,auto_update_workstation_from_server,ServerVersion==$ServerVersion,ServerPatchLevel==$ServerPatchLevel"; ::puts "rwb1_debug,auto_update_workstation_from_server,WorkstationVersion==$WorkstationVersion,WorkstationPatchLevel==$WorkstationPatchLevel"; } /* { 2.34.11 - Used to compare release but now compare version and patchlevel separately. Reason is that 2.34.11 string compares smaller than 2.34.9 Also changed the download dialog text to say whether version or patchlevel changed. */ } /* { ::set CannotUpdate 0; ::set VersionChanged 0; # 2.34.11 - more targetted message that says whether version or patchlevel changed. ::if {$WorkstationVersion>$ServerVersion} { ::set CannotUpdate 1; ::set VersionChanged 1; } else { ::if {$WorkstationVersion==$ServerVersion} { ::if {$WorkstationPatchLevel>$ServerPatchLevel} { ::set CannotUpdate 1; } } } */ } # 2.37.2 - got the login wrong in the code above. ::if {$WorkstationVersion>$ServerVersion} { ::set CannotUpdate 1; ::set VersionChanged 1; ::set OnlyTheDateChanged 0; } ::if {$WorkstationVersion<$ServerVersion} { ::set CannotUpdate 0; ::set VersionChanged 1; ::set OnlyTheDateChanged 0; } ::if {$WorkstationVersion==$ServerVersion} { ::if {$WorkstationPatchLevel>$ServerPatchLevel} { ::set CannotUpdate 1; ::set VersionChanged 1; ::set OnlyTheDateChanged 0; } ::if {$WorkstationPatchLevel<$ServerPatchLevel} { ::set CannotUpdate 0; ::set VersionChanged 0; ::set OnlyTheDateChanged 0; } ::if {$WorkstationPatchLevel==$ServerPatchLevel} { /* { We should never be here but we'll ignore it. */ } # ::qw::warning 314120230901091636 "Expected change in patch level, workstation release $WorkstationRelease, server release $ServerRelease."; ::set CannotUpdate 0; ::set VersionChanged 0; ::set OnlyTheDateChanged 1; } } ::if {$CannotUpdate} { /* { Regardless of what's greater than what, we do not allow a newer workstation to connect to an older server. */ } ::qw::throw [::subst -nocommands { .text "Workstation release cannot connect to server with older release." .text1 "Workstation release $::qw_release cannot connect to server with older release $ServerRelease" .help_page { .id 314120150226102221 .tags {error} .body { [p { Workstation release: [bold $::qw_release] }] [p { Server release: [bold $ServerRelease] }] [p { The workstation release is newer than the server release. You can't connect the workstation to a server that has an older release. Note that if the server had a release newer than the workstation, you would be able to update the workstation from the server right now. }] [h3 "How did this situation happen?"] [p { The workstation was last updated from a different newer server, or directly from the Q.W.Page web site, and the server was not updated to the same release. }] [h3 "What should you do now?"] [p { You should update the server to ensure that the latest release of NV2 is installed on the server. To check the version of either a workstation or the server, issue the [qw_menu_command "Help" "About"] command. If necessary, call Q.W.Page customer support to rectify the situation. }] [h3 "Change introduced in version 2.28"] [p { Prior to version 2.28 a workstation could always connect to a server if they had the same version, even if the release dates were different, including the case when the workstation was newer than the server. This functionality was changed in version 2.28 at the same time that the ability to update a workstation from a server was introduced. Generally you should now update the server from Q.W.Page, and then automatically update the workstations from that server the first time you attempt to connect. }] [h3 "Another scenario that can result in this situation."] [p { This situation can also occur under a specific set of circumstances described here. Suppose you install a NewViews update into a different folder. That is, you are currently installed in folder A but you install the update in folder B. When you use the windows service installer to install the NewViews service, the service installer prompt might still specify the NewViews program and server database in folder A. Thus the program running the service is [qw_quoted "old"] compared to the newly installed version in folder B that you use to run the workstation. }] [p { Note also that when you install the new version into folder B the service, if currently running, is uninstalled and re-installed. However, it is re-installed with the same values such as the path to the program and server database, meaning the program and database in folder A, not B. So you will again get this error message when you try to connect. }] [p { See more on [link .chm [::file join $::qw_data manual.chm] .id 618020080114121017 {Appendix F - Upgrading to a new version of NewViews}]. }] } } }]; } # ------------------------------------------------------------ # Workstation release < server release so ask user to confirm update. # ------------------------------------------------------------ ::if {$VersionChanged} { # 2.34.11 - more targetted message that says whether version or patchlevel changed. ::set ChangeText [::subst -nocommands { The server version ([bold $ServerVersion]) is newer than the workstation version ([bold $::qw_version]) so the workstation must be updated before it can access the server. }]; } else { ::set ChangeText [::subst -nocommands { The version ([bold $ServerVersion]) has not changed but the server patch level ([bold $ServerPatchLevel]) is newer than the workstation patch level ([bold $WorkstationPatchLevel]) so the workstation must be updated before it can access the server. }]; ::if {$OnlyTheDateChanged} { /* { Overriding the text above with a special case. We released 2.38.5.20250623 on the cloud and then discovered a minor but show-stopper bug. Instead of changing the patchlevel we left it where it was and just changed the build date. */ } ::set ChangeText [::subst -nocommands { The version ([bold $ServerVersion]) and patch level ([bold $ServerPatchLevel]) have not changed but the server build date [bold $ServerBuild] is newer than the workstation build date [bold $WorkstationBuild] so the workstation must be updated before it can access the server. }]; } } ::set Confirm [::qw::dialog85::confirm [::subst -nocommands { .title {Install update?} .html { .body { [h2 {Update workstation?}] [p { Workstation release: [bold $::qw_release]. }] [p { Server release: [bold $ServerRelease]. }] [p { $ChangeText }] [p { [qw_button Ok] (recommended) - download, install, and restart. }] [p { [qw_button Dismiss] - take no action at this time and you can try again later. }] } .width 5i .height 3i } .help_page { .id 314120150216160349 .tags {error} .body { [h2 "Updating the workstation."] [p { The update will automatically download from the server and install. }] [p { Whenever you try to open a database on a remote server, the releases (version and patch level) of the server and workstation are compared. If the server is newer you can download a NewViews update immediately from the server and install it on the workstation. All it takes is a single click. If you confirm that you want to update, this will happen: }] [ol { [li { [p { The NewViews installation file will download. }] [p { This file is big (over 50 Megabytes) but if your server is on a local area network it should download very quickly. Only the server needs to be updated from the Q.W.Page web site, and the workstations can then update directly from the server. The installation file is copied into the NewViews program folder. }] }] [li { [p { The workstation will shut down. }] [p { Open databases are closed at this point. You can re-open them after the update. Also close the manual, if open, and stop the NewViews Service if running. }] }] [li { [p { The update will be installed. }] [p { The start menu is updated, the new manual, templates, demo databases and so on are installed. You are no longer required to accept a license agreement or specify an installation folder. It is already known that you are registered and where the installation folder is. }] }] [li { [p { The workstation will restart. }] [p { Note that if the NewViews version changed (i.e. say 2.28 to 2.29) then there may be some database processing as the workstation is converted to the new version. This optional conversion will happen automatically and without prompting for confirmation. The workstation release now matches the server release so you can now open the database. }] }] }] } } }]]; ::if {!$Confirm} { ::qw::throw \ .text "Auto-update aborted." \ .priority ignore \ ; } ::if {$rwb1_debug} {::puts "rwb1_debug,auto_update_workstation_from_server,main,1000.20";} ::set DownloadResult [download_the_install_executable]; ::if {$rwb1_debug} {::puts "rwb1_debug,auto_update_workstation_from_server,main,1000.21,DownloadResult==$DownloadResult";} # ------------------------------------------------------------ # Ask socket to destroy itself. # ------------------------------------------------------------ ::qw::try { /* { This call tells the server to destroy the socket. Otherwise the server will have a dangling (but disconnected) socket. This is not a serious problem but if the server is shut down, generally an old-style server, then the system collection of sockets will throw a bug. We don't want that situation to occur. We don't use a signal because there is no precedent for sending signals from client to server. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,auto_update_workstation_from_server,main,1000.22,plug_exists==[::qw::command_exists $_plug]";} $_plug cpp_tcp_call \ .tcp { .command call .source plug .destination socket .priority foreground } \ .command socket_destroy \ ; ::if {$rwb1_debug} {::puts "rwb1_debug,auto_update_workstation_from_server,main,1000.23,plug_exists==[::qw::command_exists $_plug]";} } catch dummy { /* { The socket will self-destruct and this will cause us to have a lost connection exception. We will ignore this and motor on. I really wish we had a better non-kludge solution to this problem. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,auto_update_workstation_from_server,main,1000.24,plug_exists==[::qw::command_exists $_plug],Exception==$dummy;"} } ::if {$DownloadResult ne "succeeded"} { ::qw::throw .text "Download did not complete." .priority ignore; } ::if {$DownloadResult eq "succeeded"} { # ------------------------------------------------------------ # Install the newly downloaded update. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,auto_update_workstation_from_server,main,1000.25";} install_after_download $sargs; ::if {$rwb1_debug} {::puts "rwb1_debug,auto_update_workstation_from_server,main,1000.26;"} } ::if {$rwb1_debug} {::puts "rwb1_debug,auto_update_workstation_from_server,main,1000.27";} } method download_the_install_executable {sargs} { /* { In 2.34.0 we replaced the red progress with the blue progress. Instead of a single uninterruptable file send from the server, the client now calls the server to send a megabyte at a time. The operation can be aborted and the server can process other calls between calls to download a megabyte. */ } ::set rwb1_debug 0; ::qw::fileutil::delete_files_in_folder .folder $::qw_program_folder .mask_list [::list *.tmp]; # ------------------------------------------------------------ # Create server side file sender. # ------------------------------------------------------------ /* { The following call will create a file sender on the server. The file path in this case is decided on the server side and it's name and several properties are returned in a structure. In this case the file should be an nv2_install.exe file. */ } ::set Script [::list ::qw::script::source \ .script.path [::file join system auto_update auto_update_workstation_from_server.qw_script] \ .download_command server_side_file_sender_create \ ]; ::set Result [$_plug cpp_socket_eval .script $Script]; ::set _server_side_file_path [::sargs::get $Result .path]; ::set _server_side_file_size [::sargs::integer_get $Result .size]; ::set ServerSideFileSizeReal $_server_side_file_size.0; ::set _server_side_file_mtime [::sargs::integer_get $Result .mTime]; ::set _server_side_file_atime [::sargs::integer_get $Result .aTime]; ::set _server_side_file_sender [::sargs::get $Result .server_side_file_sender]; ::set _client_side_file_name [::file tail $_server_side_file_path]; ::set _client_side_file_path [::file join $::qw_program_folder $_client_side_file_name]; ::if {[::file exists $_client_side_file_path]} { /* { This can happen if a previous download succeeded but the installation did not. In this case there is no need to download again. */ } ::return "succeeded"; } /* { We need to collect the target before we download but for now we will download into a pre-defined path in the program folder. */ } ::set TargetFreespace [::qw::fileutil::disk_freespace .path $::qw_program_folder]; ::set TargetFreespaceReal $TargetFreespace.0; ::if {$TargetFreespaceReal<$ServerSideFileSizeReal} { /* { Using reals is necessary for large files in tcl 8.4 because ints are limited to 32-bit. */ } ::set Result [$_plug cpp_socket_eval .script [::list $_server_side_file_sender server_side_sender_destroy]]; ::set ServerSideFileSizeFormatted [::qw::number::format $_server_side_file_size $::qw::number::formats(integer)] ::set TargetFreespaceFormatted [::qw::number::format $TargetFreespace $::qw::number::formats(integer)] ::set Text "Not enough disk free space to download database."; ::append Text "\n\nAvailable disk free space: $TargetFreespaceFormatted"; ::append Text "\n\nFile size: $ServerSideFileSizeFormatted"; ::qw::dialog3::notify \ .title "Not enough disk space to download." \ .text $Text \ ; ::return "insufficient_disk_space"; } # ------------------------------------------------------------ # Create/open the client side temp file. # ------------------------------------------------------------ ::set Count 0; ::while {1} { /* { Debate: We could create the temp file in the temp folder. Then it would be cleaned up automatically on failure. But this only works if the temp folder is on the same disk as the ultimate destination for two reasons: renaming involves a copy (not just a move), and checking for disk space would involve both the temp disk and the destination disk. So let's just assume you need space on the destination disk. */ } ::set _client_side_temp_file_path [::file join $::qw_program_folder nv2_installation_download_$Count.tmp]; ::if {![::file exists $_client_side_temp_file_path]} { ::break; } ::incr Count; } ::set _client_side_file_handle [::open $_client_side_temp_file_path w+]; ::fconfigure $_client_side_file_handle -translation binary; # ------------------------------------------------------------ # Create a blue progress bar - work with megabytes, not bytes. # ------------------------------------------------------------ /* { We ran into trouble in tcl 8.4 when files exceeded 4 Gigabytes as tcl 8.4 is working with 32 bit ints. Note that counting bytes worked for tcl 8.6, proving the logic was fine. Maybe when we move to tcl 8.6 we will go back to bytes. The problem only really came up with the counts managed byt the blue progress bar. So instead, here is what we do: (1) Blue progress counts megabytes, not bytes. (2) We request 1 meg at a time. (3) The last meg will likely be a fraction but count it as 1. Both sides don't worry about the actual number of bytes in the request for the last megabyte. */ } ::set Real "$_server_side_file_size.0"; ::set Real [::expr {$Real/1048576.0}]; ::set _server_side_file_size_megabytes [::expr {int($Real)}]; ::set ProgressLimit [::expr {int($Real)}]; ::if {floor($Real)!=$Real} { ::incr _server_side_file_size_megabytes 1; } ::set ProgressLimit $_server_side_file_size_megabytes; ::set _operation_id [::qw::progress_blue::operation_create \ .limit $ProgressLimit \ .database_path $_client_side_file_path \ .database_id [$_workstation_database cpp_database_id] \ .description "downloading file" \ .count_variable [::itcl::scope _client_side_copied_megabyte_count] \ .state "working" \ .status "downloading \"$_client_side_file_path\"." \ ]; ::set _start_seconds [::clock seconds]; # ------------------------------------------------------------ # Start downloading. # ------------------------------------------------------------ ::set _client_side_copied_megabyte_count 0; ::while {1} { /* { Each iteration downloads 1 megabyte and sleeps for a while so the server has a chance to process (admittedly slowly) other calls. Seems to work ok. Note that the workstation does not give up the processor and nor should it. */ } ::qw::sleep 100; ::if {$_client_side_copied_megabyte_count==$_server_side_file_size_megabytes} { # ------------------------------------------------------------ # Download completed successfully. # ------------------------------------------------------------ ::set Result [$_plug cpp_socket_eval .script [::list $_server_side_file_sender server_side_sender_destroy]]; ::close $_client_side_file_handle; ::file mtime $_client_side_temp_file_path $_server_side_file_mtime; ::file atime $_client_side_temp_file_path $_server_side_file_atime; ::if {[::file exists $_client_side_file_path]} { ::qw::bug 314120191022161827 "The destination file is not supposed to exist. Already checked it."; ::file delete $_client_side_file_path; } ::file rename $_client_side_temp_file_path $_client_side_file_path; ::qw::progress_blue::operation_configure .operation_id $_operation_id .state "succeeded"; ::qw::fileutil::delete_files_in_folder .folder [::file dirname $_client_side_file_path] .mask_list [::list *.tmp]; ::return "succeeded"; } ::if {[::qw::progress_blue::operation_is_aborted .operation_id $_operation_id]} { # ------------------------------------------------------------ # Download has been aborted. # ------------------------------------------------------------ download_abort; ::return "aborted"; } ::qw::try { ::set Result [$_plug cpp_socket_eval .script [::list $_server_side_file_sender server_side_send_next_chunk .chunk_size $_chunk_size]]; } catch Exception { # ------------------------------------------------------------ # Download has been aborted. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,download_blue,1000.21,Exception==$Exception";} download_abort; # 2.35.3 - $Exception was wrapped in quotes which could not be parsed correctly. ::qw::dialog3::notify [::subst -nocommands { .title "Download aborted." .html { .body { [h2 "The download was aborted due to a lost connection."] [p { The reported exception is shown below: }] [qw_code [::list $Exception]] } .width 5i .height 3i } }]; ::return "lost_connection"; } ::set Base64Size [::sargs::integer_get $Result .base64_size]; ::set Base64Data [::sargs::get $Result .base64_data]; ::if {$Base64Size!=[::string length $Base64Data]} { # ------------------------------------------------------------ # Transmission error. # ------------------------------------------------------------ download_abort; ::qw::dialog3::notify [::subst -nocommands { .title "Download aborted due to a transmission error." .html { .body { [h2 "The download was aborted due to a transmission error."] } .width 5i .height 3i } }]; ::return "transmission_error"; } # ------------------------------------------------------------ # Write the downloaded magabyte and continue. # ------------------------------------------------------------ ::set Data [::qw::base64::decode .data $Base64Data]; ::puts -nonewline $_client_side_file_handle $Data; ::flush $_client_side_file_handle; # ------------------------------------------------------------ # Update blue progress. # ------------------------------------------------------------ /* { We have to call operation_configure because we our dialog has grabbed the processor and will not allow updates. The blue progress requires 1-second tick updates to display and these are implemented using ::after. So we are giving the blue_process a chance to update every time we call operation_configure. */ } ::incr _client_side_copied_megabyte_count; ::qw::progress_blue::operation_configure .operation_id $_operation_id; } } method download_abort {sargs} { # ------------------------------------------------------------ # Clean up when aborting. # ------------------------------------------------------------ ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,download_abort,1000.18,sargs==\n$sargs";} # ------------------------------------------------------------ # Update the blue progress bar. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,download_abort,1000.1";} ::if {$_operation_id ne ""} { ::qw::progress_blue::operation_configure .operation_id $_operation_id .state "aborted"; ::set _operation_id ""; } ::if {$rwb1_debug} {::puts "rwb1_debug,download_abort,1000.2";} # ------------------------------------------------------------ # Destroy the server_side_file sender object. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,download_abort,1000.3";} ::if {$_server_side_file_sender ne ""} { ::qw::try { ::if {[::qw::command_exists $_plug]} { ::set Result [$_plug cpp_socket_eval .script [::list $_server_side_file_sender server_side_sender_destroy]]; } } catch dummy { } } # ------------------------------------------------------------ # Close the client side temp file. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,download_abort,1000.4";} ::if {$_client_side_file_handle ne ""} { ::qw::try { ::close $_client_side_file_handle; ::set $_client_side_file_handle ""; } catch dummy { } } ::if {$rwb1_debug} {::puts "rwb1_debug,download_abort,1000.5";} # ------------------------------------------------------------ # Delete client side temp files. # ------------------------------------------------------------ ::qw::fileutil::delete_files_in_folder .folder [::file dirname $_client_side_file_path] .mask_list [::list *.tmp]; ::if {$rwb1_debug} {::puts "rwb1_debug,download_abort,1000.6";} } method check_if_need_to_run_as_administrator {} { ::if {[::qw::service_utils::newviews_service_count]!=0} { /* { Some NewViews services are running. We need to run_as_administrator in order to install properly. */ } ::if {![::qw::service_utils::is_run_as_administrator]} { ::qw::throw \ .text "You need to run as administrator because a NewViews service is running." \ .help_page [::subst -nocommands { .id 314120160509175812 .tags {error} .body { [p { A NewViews service is running so you need to [qw_term "Run as administrator"] in order to update NewViews. }] [p { To proceed, do the following: }] [ol { [li { [p { Dismiss the error and shut NewViews. }] [p { We have to shut NewViews so you can run it again, the next time as the administrator. }] }] [li { [p { Position on the NewViews Workstation in the Window Start menu. }] }] [li { [p { Right-click on the NewViews Workstation item and select [qw_term "Run as Administrator"]. }] [p { This runs NewViews as usual and should bring up the ususal table of databases. Pick the same remote database that you tried to open before and open it (double-click on it). }] }] [li { [p { You will be asked if you want to proceed with the update. }] [p { Simply proceed by following the prompts until the upgrade completes. This time, because you are running as the administrator, the upgrade can automatically stop the services, install the upgrade, and restart the services. }] }] }] } }] \ ; } } } method check_sub_product_compatibility {sargs} { ::set ServerSubProduct [::sargs::get $_server_information .sub_product]; ::if {$ServerSubProduct eq $::qw_sub_product} { ::return; } ::array set Description { npm "Property Management" nph "Non-profit Housing" crm "Customer Relation Management" nv2 "NewViews 2" } ::qw::throw [::subst -nocommands { .text "Can't connect to a server with incompatible sub-product type." .help_page { .id 314120150226150151 .body { [p { Workstation sub-product type: [bold "$::qw_sub_product - $Description($::qw_sub_product)"]. }] [p { Server sub-product type: [bold "$ServerSubProduct - $Description($ServerSubProduct)"]. }] [p { Note that you can connect a workstation to a server regardless of sub-product type if they are the same release. But when the workstation and server have a different release you can't. We would like to auto-upgrade to the new release from the server but this can't be done when the workstation and server have different sub-product types (the manual, templates, and demonstration databases are all different, for example). }] [p { To solve this problem you should download and install NewViews sub-product type $::qw_sub_product ($Description($::qw_sub_product)) on the server. Then the workstation can connect to the server immediately if they have the same version, or else the workstation will auto-upgrade from the new server and then connect. }] [p { See more on [link .chm [::file join $::qw_data manual.chm] .id 618020080114121017 {Appendix F - Upgrading to a new version of NewViews}]. }] } } }]; } method install_after_download {sargs} { /* { */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.0"}; /* { We have downloaded nvinstall.exe. Next we have to shutdown the workstation and restart nvinstall.exe. After downloading nv_install.exe we run it. We disable dialogs and shutdown immediately. Since the program we are running is nv_install.exe, i.e. a different program, it should be able to run before the workstation is fully shutdown. Scenario - Workstation and Server on same computer. In this case the server must already have been updated. The workstation should be running the same exe so we shouldn't even be here in the first place. But if the workstation is running a different exe then it is possible we could be here. The workstation was run from a renamed exe or an exe in a different installation folder. If run from a renamed exe then the install will likely fail if the server is using nv2.exe from the same folder. If the workstation is in a different folder the install may succeed. Scenario - Other remote databases are open. In this case those remote databases would all have to be of the same release as the workstation (except if prior to 2.28). So we may end up in a situation where, after restarting, the workstation cannot connect to those servers. The error message will be that the server must be updated. Scenario - Server if for a different customer. Download anyway - pgq. Todo We should ensure that all databases accessed from the workstation can be committed before we proceed. We might also build a list of open databases that can be accessed when we eventually reboot the workstation. The install might fail. Scenario The same nv2.exe is used to run both a server and a workstation, of perhaps multiple workstations. In either case nv_install.exe will fail. The nv_install can put up an error message telling users to shut all instances of NewViews and run the install again. This should actually work but it will disrupt the continuity of th upgrade. Just don't know of any way to inform the install to ignore dialogs and/or restart the workstation. Could warn them right now -done. The -auto_update_from_server option passed to nv_install.exe tells it not to collect install folder, accept license, etc., and go directly to do_install. */ } ::set DatabaseList [[::qw::system] cpp_system_database_list]; ::if {$rwb1_debug} { ::foreach Database $DatabaseList { ::puts "rwb1_debug,install_after_download,1000.1,open database on workstation,path==[$Database cpp_database_path]"; } }; ::set Pos [::lsearch $DatabaseList $_workstation_database]; ::if {$Pos<0} { /* { This is the workstation. It had better exist and it wouldn't be a good idea to touch it so we remove it from the list of open databases. */ } ::qw::bug 314120150220144527 "[::qw::methodname] - can't find workstation database."; } ::set DatabaseList [::lreplace $DatabaseList $Pos $Pos]; /* { ::if {$_application_database ne ""} { ::set Pos [::lsearch $DatabaseList $_application_database]; ::if {$Pos<0} { /* { We have the list of application databases on the workstation. The _application_database is the one we were attempting to open and we want to remove it from the list. We don't want to try to commit or destroy a database that hasn't even been opened. Note that _application_database can be empty if the call was not to open a database. For example, we may be calling to get the list of offered databases. */ } ::qw::bug 314120150220144528 "[::qw::methodname] - can't find application database."; } ::set DatabaseList [::lreplace $DatabaseList $Pos $Pos]; */ } } ::foreach Database $DatabaseList { ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.2,open application database on workstation,path==[$Database cpp_database_path]";} } ::qw::try { ::foreach Database $DatabaseList { ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.3,database commit,path==[$Database cpp_database_path]";} /* { We had better find out where database backup is invoked and prevent it. Actually maybe it should be allowed. */ } $Database cpp_commit; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.4,database commit,path==[$Database cpp_database_path]";} } ::foreach Database $DatabaseList { ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.5,database destroy,path==[$Database cpp_database_path]";} #::qw::throw .text "artificial exception simulating inability to commit a database."; $Database cpp_destroy; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.6,database destroy";} } } catch Exception { ::if {[::sargs::is_primitive $Exception]} { ::set ExceptionText $Exception; } else { ::set ExceptionText [::sargs::get $Exception .text]; } ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.7";} ::qw::dialog85::notify [::subst -nocommands { .title "Install aborted." .html { .body { [h2 "The install was aborted."] [p { Please close all of the other NewViews application databases that are open on this workstation and try again. }] [p { Reason for abort reported as: }] [p [typewriter {$ExceptionText}]] } .width 4i .height 3i } .help_page { .tags {notify} .id 314120150209165718 .body { [h2 "The install was aborted."] [p { We couldn't close one or more of the other application databases that are open on this workstation. What we want to do is shutdown and perform the installation of the update but we can't do that unless the application databases can all be closed. }] [p { The reason for the abort was reported as: }] [p { [typewriter {$ExceptionText}] }] [h3 "Alternative - Install manually."] [p { Note that at this point the installation program ($_client_side_file_name) has been downloaded so you can shut down the workstation and run it manually by double-clicking on it in an explorer. Then just follow the prompts to install the update, and afterward, restart the workstation. }] } } }]; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.8";} ::qw::throw \ .text "The install was aborted because couldn't close an open application database." \ .priority .ignore \ ; } ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.9";} ::set Nv2Exe [::file nativename $_client_side_file_path]; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.10";} ::set Args [::list \ -workstation_database_path [$_workstation_database cpp_database_path] \ -auto_update_from_server 1 \ ]; # ::set Args $::argv; ::set CommandLine [::concat $Nv2Exe $Args]; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.11,CommandLine==\n$CommandLine";} ::set CommandLine [::string map [::list "\\" "\\\\"] $CommandLine]; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.12,CommandLine==\n$CommandLine";} ::append CommandLine " &"; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.13"}; ::set Operation [::QW::OPERATION ::QW::OPERATION::#auto .text "Running $_client_side_file_name..."]; /* { Decided we don't really need the before/after messages - just after. ::if {!$::qw::control(mothership_is_enabled)} { ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.13.0"}; ::set MothershipMessage [::sargs]; ::sargs::var::set MothershipMessage .message_type nv2_install_workstation_from_server_before; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.13.1"}; ::qw::babyship::singleton asynch_post_to_mothership .message $MothershipMessage; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.13.2"}; } */ } ::qw::finally [::list ::itcl::delete object $Operation]; ::eval ::exec $CommandLine; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.14";} ::qw::shutdown; ::if {$rwb1_debug} {::puts "rwb1_debug,install_after_download,1000.99,commandline==$CommandLine"}; /* { Throwing an exception with .priority ignore will unwind the stack, close the tcp connection, and fail to open the database, but it will not put up an error message. The qw::shutdown should take effect and we're safely out of here. */ } ::qw::throw .text "The download completed so we start the installation." \ .priority ignore \ ; # ::qw::throw .text "Shutting server because error occurred." .priority ignore; } method update_is_allowed {sargs} { /* { We are updating from the server to the workstation. But we need to know if the workstation and server upgrade policies allow the upgrade. Note that the workstation and server may be from different companies. Many of the policies are found in registration_check (qw.qw_tcl) and in nv2_install.qw_script. There are many similarities and we would like to share the code but there are too many differences. For example, we have a serial, customer number and upgrade expiry date on both the workstation and server side. Summary of when nv2_install.qw_script will and will not allow the installation: Can still install but will be in evaluation mode if: (1) Can't find nv2.dat, (2) Can't read nv2.dat (3) nv2.dat has been tampered with. (4) nv2.dat nic doe not match machine. (5) Registration date is after download build date. (6) There is no customer record in install.exe (a) nv2.dat registration date is after install.exe build date -> cannot authorize (b) nv2.dat registration date is before install.exe build date -> can install (7) nv2_upgrades_expiry_date > install.exe build date (8) nv2_upgrades_expiry_date < unstall.exe build date -> unauthorized (9) then we warn if date of nv2.exe > install.exe build date In the above, we need to replace the install.exe build date with the server.exe build date, and the customer support record must come out of the server.exe. Registration_check summary: (1) Can't find nv2.dat -> enter nv2 with a warning notify (2) return if can't read nv2.dat or if it has been tampered with (3) warning if nv2.dat nic ont found in nic list. (4) if nic address list is empty we allow entry (5) if registration date > nv2.exe build -> allow (6) if registration record not found (a) registration date < nv2.exe build date -> throw unauthorized (b) registration date < nv2.exe build date -> allow (7) Expirydate >= nv2.exe build -> allow (8) registration date == expiry date -> throw unathorized (9) if system > build + 1 year -> warning newviews is getting old Download Scenario 1 (1) If server.exe > workstation.exe we always download. (2) Then we run the install (3) The install does the checks and aborts if we cannot install. That way we don't have to put the checks in two places. Install scenario (1) Run nv2.exe as usual. (2) Discovers d:/nv/nv2.2?.?.20??????-win32-ix86-nv2.exe with build > nv2.exe build (3) Close workstation and run install.exe If the server company is not the workstation company */ } } } ::proc ${::qw::script::namespace}::main {sargs} { ::qw::finally [::list ::namespace delete [::namespace current]]; ::set Command [::sargs::get $sargs .download_command]; ::switch -- $Command { server_side_file_sender_create { # ------------------------------------------------------------ # Command called from client but runs on service_hub. # ------------------------------------------------------------ /* { rwb_todo We need to know the workstation version in order to determine which file to send. Could be nph or nv2, and could be win32 or linux. For now we know that workstations are always on Windows. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,server_side_file_sender_create,1000.00,app_name==$::qw::control(app_name),sargs==\n[::sargs::format $sargs]";} /* { rwb1_debug,server_side_file_sender_create,1000.00,app_name==app_name_service_hub,sargs== .script { .path /home/benn/nv2_stub_238/acme/nv2_hub_acme.exe/system/auto_update/auto_update_workstation_from_server.qw_script .namespace_id 4 .namespace ::qw::script::4 } .download_command server_side_file_sender_create */ } ::if {$::qw::control(process_file_is_enabled)} { /* { We are running stub/hub/node. Don't care if we are on windows or linux. Install executables are in stub folder, or can be overridden in hub folder. Can only download windows install execuatables as there is not such thing for linux. */ } ::if {$::qw::control(app_name) ne "app_name_service_hub"} { /* { In linux, only a service hub is capable of updating a workstation. */ } ::qw::bug 314120240117112406 "server_side_file_sender_create - invalid app_name \"$::qw::control(app_name)\"."; } /* { The subproduct is stored in the nv2_hub_list entry for this process. The field is .sub_product. If the field is not found then the default value is nv2. */ } ::set HubListEntry [::sargs::get $::qw_sargv .hub_list_entry]; ::if {$HubListEntry eq ""} { ::qw::bug 314120240118145337 "server_side_file_sender_create - .hub_list_entry not specified."; } ::set SubProduct [::sargs::get $HubListEntry .sub_product]; ::switch -- $SubProduct { "" { /* { When not specified, nv2 is the default. It was suggested we use the subproduct of the service_hub but no, we want to always be able to run a service_hub without specifying a subproduct. By the same token we could have always used the service_hub subproduct instead of putting it in an nv2_hub_list entry. */ } ::set SubProduct "nv2"; } nv2 { } nph { } default { ::qw::bug 314120240117112408 "server_side_file_sender_create - unknown subproduct \"$SubProduct\"."; } } ::set ServerSideFileName nv${::qw_release}-win32-ix86-$SubProduct.exe; /* { The install executable could be in the hub folder, but if not found there, then we look in the stub folder. */ } ::set ServerSideFilePath [::file join $::qw_program_path $ServerSideFileName]; ::if {![::file exists $ServerSideFilePath]} { ::set StubFolder [::sargs::get $::qw_sargv .stub_folder]; ::if {$StubFolder eq ""} { ::qw::bug 314120240117112409 "server_side_file_sender_create - invalid stub folder \"$StubFolder\"."; } ::if {![::file exists $StubFolder]} { ::qw::bug 314120240117112410 "server_side_file_sender_create - invalid stub folder \"$StubFolder\"."; } ::set ServerSideFilePath [::file join $StubFolder $ServerSideFileName]; ::puts "rwb_debug,2345.0,ServerSideFilePath==$ServerSideFilePath"; ::if {![::file exists $ServerSideFilePath]} { /* { If the server can't find the install.exe then if on windows we can just copy ourself to the program folder. If on unix we can copy the windows install.exe from the vfs. But neither of these scenarios works if the server is not a release. */ } ::set ServerHostName [::info hostname]; ::qw::throw [::subst -nocommands { .text "Server $ServerHostName is unable to update the workstation." .help_page { .id 314120191022145707 .tags {error} .body { [p { Server [qw_field_value "$ServerHostName"] does not have available the correct installation file to send to the workstation. We encourage you to report this situation to Q.W.Page customer support. }] [p { See more on [link .chm [::file join $::qw_data manual.chm] .id 618020080114121017 {Appendix F - Upgrading to a new version of NewViews}]. }] } } }]; #::qw::bug 314120240117112411 "server_side_file_sender_create - can't find installation executable \"$ServerSideFilePath\"."; } } } else { /* { We could be a windows service or we could be */ } } ::switch -- $::tcl_platform(platform) { "unix" { /* { */ } ::if {$::qw::control(app_name) ne "app_name_service_hub"} { /* { In linux, only a service hub is capable of updating a workstation. */ } ::qw::bug 314120240117112406 "server_side_file_sender_create - invalid app_name \"$::qw::control(app_name)\"."; } /* { The subproduct is stored in the nv2_hub_list entry for this process. The field is .sub_product. If the field is not found then the default value is nv2. */ } ::set HubListEntry [::sargs::get $::qw_sargv .hub_list_entry]; ::if {$HubListEntry eq ""} { ::qw::bug 314120240118145337 "server_side_file_sender_create - .hub_list_entry not specified."; } ::set SubProduct [::sargs::get $HubListEntry .sub_product]; ::switch -- $SubProduct { "" { /* { When not specified, nv2 is the default. It was suggested we use the subproduct of the service_hub but no, we want to always be able to run a service_hub without specifying a subproduct. By the same token we could have always used the service_hub subproduct instead of putting it in an nv2_hub_list entry. */ } ::set SubProduct "nv2"; } nv2 { } nph { } default { ::qw::bug 314120240117112408 "server_side_file_sender_create - unknown subproduct \"$SubProduct\"."; } } ::set ServerSideFileName nv${::qw_release}-win32-ix86-$SubProduct.exe; /* { The install executable could be in the hub folder, but if not found there, then we look in the stub folder. */ } ::set ServerSideFilePath [::file join $::qw_program_path $ServerSideFileName]; ::if {![::file exists $ServerSideFilePath]} { ::set StubFolder [::sargs::get $::qw_sargv .stub_folder]; ::if {$StubFolder eq ""} { ::qw::bug 314120240117112409 "server_side_file_sender_create - invalid stub folder \"$StubFolder\"."; } ::if {![::file exists $StubFolder]} { ::qw::bug 314120240117112410 "server_side_file_sender_create - invalid stub folder \"$StubFolder\"."; } ::set ServerSideFilePath [::file join $StubFolder $ServerSideFileName]; ::if {![::file exists $ServerSideFilePath]} { /* { If the server can't find the install.exe then if on windows we can just copy ourself to the program folder. If on unix we can copy the windows install.exe from the vfs. But neither of these scenarios works if the server is not a release. */ } ::set ServerHostName [::info hostname]; ::qw::throw [::subst -nocommands { .text "Server $ServerHostName is unable to update the workstation." .help_page { .id 314120191022145707 .tags {error} .body { [p { Server [qw_field_value "$ServerHostName"] does not have available the correct installation file to send to the workstation. We encourage you to report this situation to Q.W.Page customer support. }] [p { See more on [link .chm [::file join $::qw_data manual.chm] .id 618020080114121017 {Appendix F - Upgrading to a new version of NewViews}]. }] } } }]; #::qw::bug 314120240117112411 "server_side_file_sender_create - can't find installation executable \"$ServerSideFilePath\"."; } } } "windows" { ::switch -- $::qw::control(app_name) { "app_name_server" - "app_name_service_hub" { } default { ::qw::bug 314120240117112412 "server_side_file_sender_create - invalid app_name \"$::qw::control(app_name)\"."; } } ::set ServerSideFileName nv${::qw_release}-win32-ix86-${::qw_sub_product}.exe; ::set ServerSideFilePath [::file join $::qw_program_folder $ServerSideFileName]; ::if {$rwb1_debug} {::puts "rwb1_debug,server_side_file_sender_create,1000.1";} ::if {![::file exists $ServerSideFilePath]} { ::if {!$::qw::control(is_release)} { /* { If the server can't find the install.exe then if on windows we can just copy ourself to the program folder. If on unix we can copy the windows install.exe from the vfs. But neither of these scenarios works if the server is not a release. */ } ::set ServerHostName [::info hostname]; ::qw::throw [::subst -nocommands { .text "Server $ServerHostName is unable to update the workstation." .help_page { .id 314120191022145707 .tags {error} .body { [p { Server [qw_field_value "$ServerHostName"] does not have available the correct installation file to send to the workstation. We encourage you to report this situation to Q.W.Page customer support. }] [p { See more on [link .chm [::file join $::qw_data manual.chm] .id 618020080114121017 {Appendix F - Upgrading to a new version of NewViews}]. }] } } }]; } ::if {$rwb1_debug} {::puts "rwb1_debug,server_side_file_sender_create,1000.2";} [::qw::system] cpp_file_copy .source_file $::qw_program_path .destination_file $ServerSideFilePath; ::if {$rwb1_debug} {::puts "rwb1_debug,server_side_file_sender_create,1000.3";} #::file rename -force -- $TempPath $ServerSideFilePath; ::if {$rwb1_debug} {::puts "rwb1_debug,server_side_file_sender_create,1000.4";} } } } # ------------------------------------------------------------ # Create server_side_file_sender object. # ------------------------------------------------------------ /* { We can send the actual file. That is, there is no need to create a temporary duplicate file as we do when sending a hot database. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,server_side_file_sender_create,1000.9";} ::set FileSender [::qw::fileutil::server_side_file_sender ::qw::fileutil::server_side_file_sender::#auto]; ::if {$rwb1_debug} {::puts "rwb1_debug,server_side_file_sender_create,1000.10";} $FileSender main $sargs .server_side_file_path $ServerSideFilePath; ::if {$rwb1_debug} {::puts "rwb1_debug,server_side_file_sender_create,1000.11";} # ------------------------------------------------------------ # return sender object and file information to client. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,server_side_file_sender_create,1000.12";} ::set Result [::sargs \ .path $ServerSideFilePath \ .size [::file size $ServerSideFilePath] \ .mTime [::file mtime $ServerSideFilePath] \ .aTime [::file atime $ServerSideFilePath] \ .server_side_file_sender $FileSender \ ]; ::if {$rwb1_debug} {::puts "rwb1_debug,server_side_file_sender_create,1000.13";} ::return $Result; } } ::set Object [auto_update_workstation_from_server [::namespace current]::#auto]; ::set Result [$Object main $sargs]; ::return $Result; } /* { windows -server -service subproduct? - from running server and only running server subproduct available _service_hub - no necessary but consistent subproduct from nv2_hub_list.txt linux -server - not necessary but consistent subproduct? -service - not applicable _service_hub subproduct from nv2_hub_list.txt - executable in hub or else get from stub */ }