::qw::bug "314120250612094554" "I think we are only using the message database script."; # ------------------------------------------------------------ # Copyright (c) 2017-2022 # Q.W.Page Associates Inc. # www.qwpage.com # All rights reserved. # ------------------------------------------------------------ /* { (1) Only register servers. Registered for a maximum number of concurrent connections. (2) Server connects to crm mothership periodically to check the account balance. Is the account in good standing. Is monthly subscription being paid? Don't worry about EFT here. (3) We can configure the max connections which are controlled by the mothership. (4) Do we need a scenario where user can run without crm mothership in perpetuity. message_database_handler and asynch_post_to_message_database_handler -------------------------------------------------------------------- Currently we run them in the same process. Suppose we run them in different processes. They both need to open the same database. This is a special case of the more general problem of spokes. So if we solve spokes first, then we should have the message_manager/mothership problem solved. Spoke Database Manager ---------------------- Start with old-style server, then incorporate service_hub. We have the webserver running (or cause it to run). We install a spoke_socket_manager. The original call specifies a database or one is inferred by default, assuming the poke_socket_manager is hard-wired. The spoke_socket_manager creates a database::handle and opens it. The handle's tcl_handle is it's cookie. From now on, each call must specify a cookie. Currently a database::handle opens a socket and processes it in a binary way. Two options: A database has a collection of handles. (1) Derive binary_handle and socket_handle from a common database::handle class. Then they can both go into the same collection. (2) binary_handle and socket_handle are separate. Database has a separate collection of socket_handles. WebSockets spoke_asynch_socket versus spoke_synch_socket spoke_handler Can service short-lived http requests. Some of these can in fact access a database. Whether cookies are involved is questionable. Receives short-lived http request to open database. Creates a database::handle Creates websocket, establishes connection with client. If a socket manager has a collection of spoke odb_database_handler -------------------- Currently we have a binary socket. (1) Turn it into a text socket. (2) Derived binary and text socket from common base socket. So what is on the client size. Note that message_database_query.qw_script is on the client side. Suppose the client side is newviews. Then we're in business. The client can re-subscribe, check current status, report status, etc. We can use an http conection or a websocket connection. The real question is accessing a socket from javascript. Answer: Pretend we're in tcl and use json2sargs on the server size. Don't have tp re-implement newviews. Just allow client to register, subscribe, etc. */ } #::package require json; #::package require json::write; ::itcl::class ::qw::message_database_handler { /* { Manages the message database. Updates the /mothership/message file and replies asynchronously to babyships. Handles foreground (and background ???) queries. Manages server updates unless we move this to a separate webserver object. */ } protected variable _message_database_folder ""; protected variable _message_database_path ""; protected variable _message_database ""; protected variable _message_file ""; protected variable _babyship_message_id_index ""; protected variable _dump_message_file_path ""; protected variable _mothership_txt_is_enabled 0; # don't need this since we have query capability protected variable _customer_support_serial_records; # customer_support_registrations.qw_tcl protected variable _customer_support_serial_records_file_mtime 0; protected variable _bad_message_check 0; protected variable _mothership_index_path_list [::list]; protected variable _title "Message Database Manager"; protected variable _stats_field_name_list [::list]; protected variable _toplevel ""; protected variable _stats; constructor {} { ::switch -glob -- [::string tolower [::info hostname]] { benn_2020 { ::set _message_database_path [::file join c:/ htdocs qw_message_database message_database.nv2]; } benn7 { ::set _message_database_path [::file join c:/ htdocs qw_message_database message_database_a.nv2]; } default { ::set _message_database_path [::file join $::qw_program_folder qw_message_database message_database.nv2]; } } ::set _message_database_folder [::file dirname $_message_database_path]; ::set _dump_message_file_path [::file join $_message_database_folder mothership_message_debug_dump.txt]; ::array set _customer_support_serial_records {} ::set PathList [::list]; ::lappend _mothership_index_path_list "/mothership/index/babyship_date"; # 0 ::lappend _mothership_index_path_list "/mothership/index/message_type_value"; # 1 ::lappend _mothership_index_path_list "/mothership/index/message_type"; # 2 ::lappend _mothership_index_path_list "/mothership/index/message_type/message_type_value"; # 3 ::lappend _mothership_index_path_list "/mothership/index/customer_id"; # 4 ::lappend _mothership_index_path_list "/mothership/index/customer_id/message_type_value"; # 5 ::lappend _mothership_index_path_list "/mothership/index/customer_id/message_type"; # 6 ::lappend _mothership_index_path_list "/mothership/index/customer_id/message_type/message_type_value"; # 7 /* { We need the use an array for _stats because we use -textvariable in the window that displays them. We use this list to maintain the order in which they are displayed. */ } ::foreach {Name Text} { sargs_call_received "message database calls" sargs_call_return "message database returns" sargs_call_exception "message database errors" mothership_message_request "mothership post requests" mothership_message_reply "mothership post replies" mothership_message_error "mothership post errors" mothership_message_bugs "bug messages" ping_count "Pings" } { ::lappend _stats_field_name_list $Name; ::set _stats(.$Name.count) 0; ::set _stats(.$Name.text) $Text; } } method destructor {} { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,mothership,destructor,1000.0";} #dump_message_file ::if {$rwb1_debug} {::puts "rwb1_debug,mothership,destructor,1000.1";} ::if {[::qw::command_exists $_babyship_message_id_index]} { $_babyship_message_id_index cpp_destroy; ::set _babyship_message_id_index ""; } ::if {[::qw::command_exists $_message_file]} { $_message_file cpp_destroy; ::set _message_file ""; } ::if {[::qw::command_exists $_message_database]} { $_message_database cpp_destroy; ::set _message_database ""; } ::if {[::qw::command_exists ::qw::http_handler::singleton]} { ::qw::http_handler::singleton call_handler_unset .prefix /asynch_post_to_mothership; } ::if {$rwb1_debug} {::puts "rwb1_debug,mothership,destructor,1000.99";} } method application_exit {} { ::set Result [::qw::dialog3::confirm .text "Ok to shut down message database handler?"]; ::if {!$Result} { ::return; } ::qw::try { /* { If a user is manually shutting the message database down then we probably don't want the restart it automatically either. */ } ::qw::taskutil::task_make_unscheduled .task_name qw_message_database; } catch Dummy { } ::itcl::delete object $this; ::rename ::qw::message_database::singleton ""; ::qw::shutdown; } method main {sargs} { /* { 2.33.2 - added .message_list and .response_list */ } ::set rwb1_debug 0; ::wm deiconify .; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_handler::main,1000.0";} message_database_boot; ::qw::http_handler::singleton call_handler_set .prefix /message_database .call_callback [::list $this tcp_call_receive]; ::qw::http_handler::singleton post_handler_set .prefix /asynch_post_to_mothership .post_callback [::list $this asynch_post_to_message_database]; ::Url_PrefixInstall /ping [::itcl::code $this ping_handler /ping]; window_setup $sargs; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_handler::main,1000.99";} } method stats_increment {StatName {Increment 1}} { ::if {[::qw::list::lsearch .list $_stats_field_name_list .pattern $StatName]<0} { ::qw::bug 314120200819180200 "[::namespace current]::[::qw::methodname] - invalid stats field name \"$StatName\"."; } ::incr _stats(.$StatName.count) $Increment; } method window_setup {sargs} { ::set Count 0; ::while {[::winfo exists .message_database_server$Count]} { ::incr Count 1; } ::set _toplevel .message_database_server$Count; ::toplevel $_toplevel; # option add *font 9x15 ::wm title $_toplevel $_title; ::wm protocol $_toplevel WM_DELETE_WINDOW [::itcl::code $this application_exit]; ::wm protocol . WM_DELETE_WINDOW [::itcl::code $this application_exit]; # ::wm iconname $_toplevel [::file join $::qw_program_path nv2.ico]; # ::after idle [::list ::wm withdraw .]; # doesn't work in foreground ::wm iconname $_toplevel "$_title\n[::info hostname]"; ::append MessageText "$_title\n[::info hostname]"; # ::append MessageText "\nRoot:$_doc_root" ::append MessageText "\n[::clock format [::clock seconds] -format {%a %d-%b-%Y %H:%M:%S}]" ::message $_toplevel.message -text $MessageText -aspect 1000 -font "Arial 15"; ::grid $_toplevel.message -columnspan 2 -sticky news; ::foreach Name $_stats_field_name_list { ::label $_toplevel.l$Name -text $_stats(.$Name.text) -font "Arial 12"; ::label $_toplevel.n$Name -textvariable [::itcl::scope _stats(.$Name.count)] -width 0 -font "Arial 12"; ::grid $_toplevel.l$Name $_toplevel.n$Name -sticky w; ::grid configure $_toplevel.n$Name -sticky e; } ::button $_toplevel.quit -text Quit -command [::itcl::code $this application_exit] -font "Arial 12"; ::grid $_toplevel.quit -columnspan 2; } method ping_handler {Prefix Socket Suffix} { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,ping_handler,1000.0,Prefix==$Prefix,Socket==$Socket,Suffix==$Suffix,clock==[::clock format [::clock seconds]]";} stats_increment ping_count 1; ::Httpd_ReturnData $Socket text/html "pong\n314120201202105335"; ::return; } method tcp_call_receive {Command sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,tcp_call_receive,1000.0,Command==$Command,sargs==\n[::sargs::format $sargs]";} # ::set WebSocket [::sargs::get $sargs .web.socket]; # ::set WebServer [::sargs::get $sargs .web.server]; stats_increment "sargs_call_received" 1; stats_increment "sargs_call_return" 1; ::set FullCommand [::sargs::get $sargs .command]; ::set CommandName [::lindex $FullCommand 0]; /* { ::if {[::qw::command_exists $Command]||[::info exists ::auto_index($Command)]} { # ------------------------------------------------------------ # Evaluate the .command if it's first word exists. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,tcp_call_receive,1000.2.0,Command==$Command";} /* { If there is a .command argument and the command exists (or is in ::auto_index), then we evaluate it. If it is in ::auto_index then it doesn't currently ecxist but will be loaded when we try to execute it. It would be nice if we could use the following in tcl 8.6: ::set Result [{*}$FullCommand]; But if that line were anywhere in this method (other than in a comment) then we get the error "extra characters after close-brace" when running in tcl 8.4. */ } ::set Result [::eval $Command $sargs]; ::if {$rwb1_debug} {::puts "rwb1_debug,tcp_call_receive,1000.2.1,Command==$Command";} ::return $Result; } */ } ::set CommandSargs $sargs; /* { ::set CommandSargs [::sargs]; ::foreach {Path Value} [::lrange $FullCommand 1 end] { # ------------------------------------------------------------ # Marshal the arguments into CommandSargs. # ------------------------------------------------------------ ::sargs::var::set CommandSargs $Path $Value; } */ } ::if {$rwb1_debug} {::puts "rwb1_debug,tcp_call_receive,1000.1,Command==$Command";} ::if {$rwb1_debug} {::puts "rwb1_debug,tcp_call_receive,1000.2,CommandSargs==\n[::sargs::format $CommandSargs]";} ::if {$CommandSargs ne ""&&[::sargs::is_primitive $CommandSargs]} { ::qw::throw "[::info hostname] domain_handler encountered bad command arguments, command_name==\"$CommandName\",command_sargs==\"$CommandSargs\"."; } ::switch -glob -- $Command { "evaluate" { ::if {$rwb1_debug} {::puts "rwb1_debug,tcp_call_receive,evaluate,2222.0,sargs==$sargs";} ::set Command [::sargs::get $sargs .command]; ::if {$rwb1_debug} {::puts "rwb1_debug,tcp_call_receive,evaluate,2222.0,Command==$Command";} ::set Result [::eval $Command]; ::if {$rwb1_debug} {::puts "rwb1_debug,tcp_call_receive,evaluate,2222.0,Result==$Result";} ::return $Result; } "message_database_get" { ::return $_message_database; } "message_database_handler" { ::return $this; } "message_list_load" { ::if {$rwb1_debug} {::puts "rwb1_debug,message_list_load,1000.0";} ::set MessageIdList [::sargs::get $CommandSargs .message_id_list]; ::if {$rwb1_debug} {::puts "rwb1_debug,message_list_load,1000.1,MessageIdList length==[::llength $MessageIdList]";} ::set MessageList [::list]; ::foreach MessageId $MessageIdList { ::if {$rwb1_debug} {::puts "rwb1_debug,message_list_load,1000.2";} ::set Record [$_message_file cpp_record_read .key [::list string $MessageId]]; ::if {$rwb1_debug} {::puts "rwb1_debug,message_list_load,1000.2.0,Record==\"$Record\"";} ::set Message [::sargs::get $Record .data]; ::set Message [::sargs::normalize .structure $Message]; ::if {$rwb1_debug} {::puts "rwb1_debug,message_list_load,1000.2.1";} ::lappend MessageList [::sargs::normalize .structure $Message]; ::if {$rwb1_debug} {::puts "rwb1_debug,message_list_load,1000.2.2";} } ::if {$rwb1_debug} {::puts "rwb1_debug,message_list_load,1000.4";} ::return $MessageList; } "dump_ifs_file" { /* { Usage: dump_ifs_file .source_path $PathToIfsFile ?.destination_path $PathToHostFile? ?.formatted 0/1?; Dumps the specified ifs file records to a destination host file. If the destination host file is not specified then a record list is returned. This could easily blow memory or cause a time out on either server or client side. If you want to send a mothership ifs file to a host file on the client side then you can first check the number of records using cpp_file_record_count. Small file can be downloaded using dump_ifs_file and larger files can be downloaded a record at a time or in groups using cpp_file_record_read_vector. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,tcp_call_receive,dump_ifs_file,1000.1,command==$Command";} ::set SrcPath [::sargs::get $CommandSargs .source_path]; ::set DstPath [::sargs::get $CommandSargs .destination_path]; ::set IfsFile [$_message_database cpp_file_factory]; ::qw::finally [::list $IfsFile cpp_destroy]; $IfsFile cpp_file_open .path $SrcPath; ::set ProgressLimit [$IfsFile cpp_record_count]; ::if {$rwb1_debug} {::puts "rwb1_debug,tcp_call_receive,dump_ifs_file,1000.2,SrcPath==$SrcPath,RecordCount==$ProgressLimit";} ::set DstHandle [::open $DstPath w+]; ::qw::finally [::list ::close $DstHandle]; ::for {::set Record [$IfsFile cpp_record_first .totals_load 1]} {[::sargs::size $Record]!=0} {::set Record [$IfsFile cpp_record_next $Record .totals_load 1]} { ::set MessageId [::lindex [::sargs::get $Record .key] end]; ::if {[::sargs::boolean_get $sargs .formatted]} { ::puts $DstHandle "[::sargs::format $Record]"; } else { ::puts $DstHandle "$Record"; } } ::return ""; } "dump_messages" { /* { Usage: dump_messages ?.host_path $PathToHostFile?; Dumps messages to destination host file. Messages are formatted. Each message is wrapped in field name .$MessageId to make bracket matching easier. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,tcp_call_receive,dump_messages,1000.1,command==$Command";} ::set SrcPath "/mothership/message"; ::set DstPath [::sargs::get $CommandSargs .host_path]; ::if {$DstPath eq ""} { ::set DstPath [::file join [::file dirname $_message_database_path] dumped_messages.txt]; } ::set IfsFile [$_message_database cpp_file_factory]; ::qw::finally [::list $IfsFile cpp_destroy]; $IfsFile cpp_file_open .path $SrcPath; ::set ProgressLimit [$IfsFile cpp_record_count]; ::set DstHandle [::open $DstPath w+]; ::fconfigure $DstHandle -translation binary; ::qw::finally [::list ::close $DstHandle]; ::for {::set Record [$IfsFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$IfsFile cpp_record_next $Record]} { ::set MessageId [::lindex [::sargs::get $Record .key] end]; ::set Message [::sargs .$MessageId [::sargs::get $Record .data]]; ::puts $DstHandle "[::sargs::format $Message]"; } ::return ""; } "message_database_reorganize" { ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_reorganize,1000.1,command==$Command";} message_database_rebuild_indexes; ::return ""; } } /* { The command could not be found. It doesn't exist (and not in auto_index), and it is not a match in the switch statement. */ } stats_increment "sargs_call_error" 1; stats_increment "sargs_call_return" -1; ::qw::error 314120201125153158 "[::namespace current]::[::qw::methodname] - unknown command \"$Command\"."; } method dump_message_file {} { ::set rwb1_debug 0; ::if {$rwb1_debug} { ::set IfsFile [$_message_database cpp_file_factory]; $IfsFile cpp_file_open .path "/mothership/message"; ::qw::finally [::list $IfsFile cpp_destroy]; ::set Handle [::open $_dump_message_file_path w+]; ::qw::finally [::list ::close $Handle]; ::for {::set Record [$IfsFile cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$IfsFile cpp_record_next $Record];} { ::set Message [::sargs::get $Record .data]; ::set MothershipMessageId [::sargs::get $Message .mothership.message_id]; ::puts $Handle [::sargs::format [::sargs .$MothershipMessageId $Message]]; } } } method message_database_boot {sargs} { /* { Babyship boots -------------- Send all messages in open_message_file. Builds open message array. Babyship Processes Responses Extracts babyship_message_id. If message in open message array unset the message array delete message from babyship_open_message_file. Babyship Sends Message (1) Generates babyship_message_id and sends message. (2) Send message (asynch). (3) Append message to open_message_file and set in open_message_array. Mothership boots ---------------- Opens message_recovery_file. Adds each message to message_structure_file Processes incoming messages. Gets mothership_message_id, adds to message. Adds message to message_structure_file. Appends message to message_recovery_file Inserts records in indexes Sends response - ok. Mothership database commit - from "time to time". Outstanding problem: mothership sends response. How does it know if/when babyship gets it. If babyship misses response then it will send again in the future. Mothership will find message and return ok. Otherwise mothership will add message and return ok. We use the odb_object_id call for message object ids. Thus they will be in the order created. The babyship also creates a message_id which is unique to that babyship and which os designed to be unique in general. Note - babyship messages are not associated with a particular database in general so can't use strictly odb_object_ids. */ } ::set rwb1_debug 0; ::if {![::file exists $_message_database_path]} { # ------------------------------------------------------------ # Create the database if it doesn't exist, but confirm first. # ------------------------------------------------------------ ::set Text ""; ::append Text "Database \"$_message_database_path\" was not found."; ::append Text "\n\nClick to create a new database in file \"$_message_database_path\"."; ::append Text "\nClick to dismiss this window without creating a database."; ::set Result [::qw::dialog3::confirm \ .title "Create mothership database?" \ .text $Text \ /button/ok.text "Create Mothership Database" \ .help_page [::subst -nocommands { .title "Create Database" .id 314120200824160321 .tags {} .body { [h2 "Do you want to create a new database file [qw_directory {$_message_database_path}]?"] [p { The database that you attempted to open was not found. }] [p { Click [qw_button "Cancel"] if you simply entered an incorrect file path and do not want to create a new database. }] [p { Click [qw_button "Create Mothership"] if you want to create a new database as file [qw_directory [qw_s_args .database_path]]. }] } }] \ ]; ::if {!$Result} { ::qw::throw \ .text "User declined to create a database." \ .priority ignore \ ; } ::if {![::file exists [::file dirname $_message_database_path]]} { ::file mkdir [::file dirname $_message_database_path]; } [::qw::odb::factory database] cpp_database_create .database_path $_message_database_path .database_type "application" .access "singleuser" .server "" .port ""; } # ------------------------------------------------------------ # Open the message database. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.0";} ::set _message_database [::qw::odb::factory database]; ::set Database $_message_database; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.1,_message_database_path==$_message_database_path";} $Database cpp_database_open .access singleuser .session_check_skip 1 .database_path $_message_database_path; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.2";} ::if {![$Database cpp_file_exists .path "/mothership/message"]} { # ------------------------------------------------------------ # Create the message file on demand. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.3";} # sorted by .mothership.message_id $Database cpp_file_create \ .path "/mothership/message" \ .branch_order 256 \ .leaf_order 16 \ .schema.key [::list string] \ .schema.amounts [::list .count] \ ; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.4";} # ------------------------------------------------------------ # Create the babyship_id index # ------------------------------------------------------------ $Database cpp_file_create \ .path "/mothership/babyship_message_id_index" \ .branch_order 256 \ .leaf_order 256 \ .schema.key [::list string] \ .schema.amounts [::list .count] \ ; } ::if {[$Database cpp_file_exists .path "/mothership/babyship_id"]} { # ------------------------------------------------------------ # Rename this index (historical reasons). # ------------------------------------------------------------ /* { This index is special because it is needed to process incoming messages. It is information bearing in a way because it is used to see if incoming messages have already been processed. We get it out of the /mothership/index/* "namespace" because it is not treated like other non-information bearing indexes. It is also special because the key has one string and the mothership_message_id is in the data, not the last component of the key. We might change this in the future. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.4.0";} $Database cpp_file_rename \ .before "/mothership/babyship_id" \ .after "/mothership/babyship_message_id_index" \ ; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.4.1";} } ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.5";} # ------------------------------------------------------------ # Open the message file and the babyship_message_id_index files. # ------------------------------------------------------------ ::set _message_file [$_message_database cpp_file_factory]; $_message_file cpp_file_open .path "/mothership/message"; ::set _babyship_message_id_index [$_message_database cpp_file_factory]; $_babyship_message_id_index cpp_file_open .path "/mothership/babyship_message_id_index"; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.6";} ::if {![$Database cpp_file_exists .path "/mothership/index/message_type"]} { # ------------------------------------------------------------ # Populate the indexes. # ------------------------------------------------------------ /* { We could have checked for the existence of any of the indexes so choice was arbitrary. In rality we will build non-empty indexes only the first time we visit an "old-style" mothership that had a object structure file but no indexes. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.7";} message_database_rebuild_indexes; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.8";} } ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_boot,1000.99";} } method crm_serial_record_find {sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,crm_serial_record_find,1000.0,sargs==\n[::sargs::format $sargs]";} ::set FilePath [::file join $::qw_program_folder customer_support_registrations.qw_tcl]; ::set mTime [::file mtime $FilePath]; ::if {$mTime!=$_customer_support_serial_records_file_mtime} { # ------------------------------------------------------------ # Load customer registrations. # ------------------------------------------------------------ /* { Load the customer registrations on demand. We save the file's mtime reload if it changes. Note that we initialize the mtime to zero so it starts out by loading when the mothership boots. In the future we will access the crm database directly. */ } ::array unset _customer_support_serial_records; ::array set _customer_support_serial_records {}; ::set _customer_support_serial_records_file_mtime $mTime; ::if {$rwb1_debug} {::puts "rwb1_debug,crm_serial_record_find,1000.1";} ::set RegistrationList [::sargs::file::get $FilePath]; ::if {$rwb1_debug} {::puts "rwb1_debug,crm_serial_record_find,1000.2";} ::foreach {Name Record} $RegistrationList { ::set CustomerNumber [::sargs::get $Record .customer_number]; ::set SerialNumber [::sargs::get $Record .nv2_serial_number]; ::if {$CustomerNumber eq ""} { ::qw::bug "314120180518112012" "crm_serial_record_find - empty customer number."; } ::if {$SerialNumber eq ""} { ::qw::bug "314120180518112013" "crm_serial_record_find - empty serial number."; } ::if {$rwb1_debug} {::puts "rwb1_debug,crm_serial_record_find,1000.3,SerialNumber==$SerialNumber,CustomerNumber==$CustomerNumber";} ::sargs::var::set Record .maximum_connection_count 5; #rwb__debug ::sargs::var::set Record .nv3_release $::qw_release; #rwb__debug ::set Record [[::qw::system] cpp_encryption_checksum_set $Record]; ::set _customer_support_serial_records($SerialNumber) $Record; ::if {$rwb1_debug} {::puts "rwb1_debug,crm_serial_record_find,1000.4,Record==$Record";} } ::if {$rwb1_debug} {::puts "rwb1_debug,crm_serial_record_find,1000.5'";} } /* { ../nv2.dat/program.qw_reg ------------------------- .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 BE21E3EBE69A8398649ECFD2B8911A76 customer_registrations.qw_tcl record: ------------------------------------- .4267 { .nv2_serial_number NV2-073393-10 .nv2_upgrades_expiry_date 20190313 .customer_number 7003939 } .3125 { .nv2_serial_number INTERNAL-BENN-5 .nv2_upgrades_expiry_date 20191231 .customer_number INTERNAL-BENN } babyship message computer information: ------------------------------------- .computer_information { .qw { .app_name app_name_server .release 2.32.3_alpha.20180504 .nameofexecutable /home/benn/nv/nv2.exe .hostname benn-Aspire-TC-710 .sub_product nv2 .ip 192.168.0.212 .nic f4:4d:30:0a:c3:f3 } .registration { .warning1 {**************************** WARNING ***************************} .warning2 {Uncontrolled changes to this file will render NewViews unusable.} .warning3 {**************************** WARNING ***************************} .serial INTERNAL-BENN-UBUNTU .nic f4:4d:30:0a:c3:f3 .date 20180307 .checksum AD01EB9F6677DF1CA624B20DCAE311D0 } .customer_support_registration { .nv2_serial_number INTERNAL-BENN-UBUNTU .nv2_upgrades_expiry_date 20191231 .customer_number INTERNAL-BENN } } */ } ::if {$rwb1_debug} {::puts "rwb1_debug,crm_serial_record_find,1000.6";} ::set CustomerNumber [::sargs::get $sargs .computer_information.customer_support_registration.customer_number]; ::if {$rwb1_debug} {::puts "rwb1_debug,crm_serial_record_find,1000.7";} ::set SerialNumber [::sargs::get $sargs .computer_information.customer_support_registration.nv2_serial_number]; ::if {$rwb1_debug} {::puts "rwb1_debug,crm_serial_record_find,1000.8,SerialNumber==$SerialNumber,CustomerNumber==$CustomerNumber";} # ::set CustomerRecord ""; ::if {[::info exists _customer_support_serial_records($SerialNumber)]} { /* { The customer exists and we have his serial list. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,crm_serial_record_find,1000.9,registration==\n[::sargs::format $_customer_support_serial_records($SerialNumber)]";} ::return $_customer_support_serial_records($SerialNumber); } /* { Return the fact that there is no record. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,crm_serial_record_find,1000.10";} ::return ""; } method message_queue_background {sargs} { /* { When a message comes in we insert it into the message file and babyship_message_id index. We append the babyship_id to a babyship_id_queue file and we commit the database. Then a background task takes a record from the babyship id queue, updates all indexes, deletes the record from the babyship id queue, and commits the database. This allows faster turnaround, especially for huge message lists. What about very large message lists? Well at least we only need insert each record into 3 indexes instead of 8 or 9. But perhaps, for simplicity, we should insert each record individually in the babyship id queue. */ } ::set Before [$_message_database cpp_file_record_first .path "/index/message_queue"]; ::if {[::sargs size $Before]==0} { # ------------------------------------------------------------ # Create the original message queue record. # ------------------------------------------------------------ ::set After [::sargs \ .key [::list string "message_queue"] \ .amounts [::list .count 1.0] \ ]; $_message_database cpp_file_record_insert .path "/message/message_queue" .after $After; reshedule; #rwb_debug ::return; } ::set MessageQueue [::sargs::get $Before .data.message_queue]; ::if {[::llength $MessageQueue]==0} { # ------------------------------------------------------------ # The queue is empty. # ------------------------------------------------------------ reshedule; #rwb_debug ::return; } # ------------------------------------------------------------ # Update indexes for one message_id. # ------------------------------------------------------------ ::set MessageId [::lindex $MessageQueue 0]; ::set MessageQueue [::lreplace $MessageQueue 0 0]; ::set After [::sargs \ .key [::list string "message_queue"] \ .data.message_queue $MessageQueue \ .amounts [::list .count 1.0] \ ]; $_message_database cpp_file_record_write .path "/message/message_queue" .before $Before .after $After; $_message_database cpp_database_safepoint; } method asynch_post_to_message_database {sargs} { # ------------------------------------------------------------ # Handles messages posted asynchronously from babyship. # ------------------------------------------------------------ /* { The mothership stores messages in a database, with several indexes for fast retrieval. Each message has a unqique mothership message_id and babyship message_id. The mothership responds to each message it receives. The babyship has an open_message.log file. It stores the messages that have not been responded to. When a response is received, the corresponding message is deleted from the open_message.log. On boot, and from time to time, the babyship retries sending the messages in it's open_message.log. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,asynch_post_to_message_database,sargs==\n[::sargs::format $sargs]";} ::set Message $sargs; stats_increment "mothership_message_request" 1 ::if {$rwb1_debug} { ::if {[::sargs::exists $Message .message_list]} { ::puts "rwb1_debug,message_count==[::llength [::sargs::get $Message .message_list]]"; ::qw::profile::finally "message_list $rwb1_debug"; } else { ::puts "rwb1_debug,message_count==1"; ::qw::profile::finally "single_message"; } } ::qw::try { # ------------------------------------------------------------ # Determine whether single message or message list. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,asynch_post_to_mothership,1000.2.0";} ::set ResponseList [::list]; ::if {[::sargs::exists $Message .message_list]} { /* { We received a list of messages, sent from a babyship nv2_open_message.log. */ } ::set MessageList [::sargs::get $Message .message_list]; ::if {$rwb1_debug} {::puts "rwb1_debug,asynch_post_to_mothership,1000.2.0.0,MessageList llength==[::llength $MessageList],MessageList string length==[::string length $MessageList]";} ::set IsMessageList 1; } else { /* { We received a single message. Turn it into a list with one element. */ } ::set MessageList [::list $Message]; ::set IsMessageList 0; } ::set MessageCount 0; ::foreach Message $MessageList { # ------------------------------------------------------------ # Process each message. # ------------------------------------------------------------ ::set BabyshipMessageId [::sargs::get $Message .babyship.message_id]; ::set IndexRecord [$_babyship_message_id_index cpp_record_read \ .key [::list string $BabyshipMessageId] \ ]; ::if {[::sargs::size $IndexRecord]!=0} { # ------------------------------------------------------------ # Same message was received and processed in the past. Resend result. # ------------------------------------------------------------ /* { We have already received and processed this message. This can happen if the mothership received the message but the response was never sent (mothership crashed) or the babyship never received it (shutdown, crashed, or connection problem). We simply respond to the message as usual. The babyship should receive the response, remove the message from nv2_open_message.log, and the babyship will not send it again. We send the message as from the message file instead of returning the message we just received because the message file message has the .result or .exception from processing the command the first time the message was received. We never try to re-process it. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,asynch_post_to_mothership,1000.4,message already processed";} ::set MothershipMessageId [::sargs::get $IndexRecord .data.mothership.message_id]; ::set MothershipRecord [$_message_file cpp_record_read .key [::list string $MothershipMessageId]]; ::if {[::sargs::size $MothershipRecord]==0} { ::qw::bug 314120170525122522 "[::namespace current]::[::qw::methodname] - can't read message file."; } ::set OriginalMessage [::sargs::get $MothershipRecord .data]; ::set BabyshipMessageId [::sargs::get $OriginalMessage .babyship.message_id]; ::set Response [::sargs]; ::sargs::var::string_set Response .babyship.message_id $BabyshipMessageId; ::if {!$IsMessageList} { # ------------------------------------------------------------ # There was a single message so return single response, not a response list. # ------------------------------------------------------------ stats_increment "mothership_message_reply" 1; ::if {$rwb1_debug} {::puts "rwb1_debug,asynch_post_to_mothership,2000.99.2,Response==$Response";} ::return $Response; } # ------------------------------------------------------------ # Append the response and handle the next message in the message list. # ------------------------------------------------------------ ::lappend ResponseList $Response; ::continue; } ::if {$rwb1_debug} {::puts "rwb1_debug,asynch_post_to_mothership,2000.2,message_count==[::incr MessageCount 1],processing new message,BabyshipMessageId==$BabyshipMessageId,milli==[::clock clicks -milliseconds]";} # ------------------------------------------------------------ # Add mothership-side information to the message. # ------------------------------------------------------------ ::set MessageType [::sargs::get $Message .message_type]; ::if {$MessageType eq "qw_bug"} { stats_increment "mothership_message_bugs" 1 } ::set MothershipMessageId [$_message_database cpp_next_object_id]; ::set MothershipSeconds [::clock seconds]; ::set MothershipYMDHMS "[::clock format $MothershipSeconds -format %Y%m%d%H%M%S]"; ::sargs::var::set Message .mothership.message_id $MothershipMessageId; ::sargs::var::set Message .mothership.clock_seconds $MothershipSeconds; ::sargs::var::set Message .mothership.ymdhms $MothershipYMDHMS; # ------------------------------------------------------------ # Insert message in message file. # ------------------------------------------------------------ ::set After [::sargs \ .key [::list string $MothershipMessageId] \ .amounts [::list .count 1.0] \ .data $Message \ ]; $_message_file cpp_record_insert .after $After; # ------------------------------------------------------------ # Insert record in babyship_message_id_index # ------------------------------------------------------------ ::set BabyshipMessageId [::sargs::get $Message .babyship.message_id]; ::set After [::sargs \ .key [::list string $BabyshipMessageId] \ .amounts [::list .count 1.0] \ .data [::sargs .mothership.message_id $MothershipMessageId] \ ]; $_babyship_message_id_index cpp_record_insert .after $After; # ------------------------------------------------------------ # Update the "regular" indexes. # ------------------------------------------------------------ insert_message_index_records .message $Message; ::if {$_mothership_txt_is_enabled} { # ------------------------------------------------------------ # Optionally append message to host message file, mothership.txt. # ------------------------------------------------------------ /* { We append the message to an external text file - useful while debugging but will leave it in until we have a better interface on message_database.nv2. */} ::switch -glob -- [::string tolower [::info hostname]] { benn* { # presumably benn_2013 ::set TextPath [::file join [::file dirname $_message_database_path] mothership.txt]; } win10-aug2016 { ::set TextPath [::file join j:/ htdocs qw_mothership mothership.txt]; # presumably was virtual machine for main mothership. } default { ::set TextPath [::file join [::file dirname $_message_database_path] mothership.txt]; } } ::set TextRecord [::sargs::format .structure [::sargs .$MothershipMessageId $Message] .indent_string "\t"]; ::qw::try { ::qw::fileutil::file_append .path $TextPath .data $TextRecord; } catch Dummy { /* { Can't afford to let anything stop the mothership. Could even be a full disk, for example. */ } ::qw::warning 314120201006104944 "[::namespace current]::[::qw::methodname] - could not write to text file $TextPath, exception==$Dummy."; } } # ------------------------------------------------------------ # Commit the database to commit the changes. (in case we crash) # ------------------------------------------------------------ $_message_database cpp_database_safepoint; ::sargs::var::string_set Response .babyship.message_id $BabyshipMessageId; ::if {!$IsMessageList} { # ------------------------------------------------------------ # Not a message list. Return single response, not message list. # ------------------------------------------------------------ stats_increment "mothership_message_reply" 1; ::if {$rwb1_debug} {::puts "rwb1_debug,asynch_post_to_mothership,2000.99.1,Response==$Response";} ::return $Response; } # ------------------------------------------------------------ # Append response to ResponseList and process next message in list. # ------------------------------------------------------------ ::lappend ResponseList $Response; } } catch Exception { ::if {$rwb1_debug} {::puts "rwb1_debug,asynch_post_to_mothership,2000.16,Exception==$Exception";} ::qw::warning 314120170525125826 "[::namespace current]::[::qw::methodname] - exception==$Exception"; } # ------------------------------------------------------------ # Send response list, commit database, and get out. # ------------------------------------------------------------ ::if {[::llength $ResponseList]==0} { /* { To get here we must have a non-empty message list and therefore also a non-empty response list. */ } # tbf_master ::qw::warning 314120190110155933 "[::namespace current]::[::qw::methodname] - empty response list."; #2.33.3 ::qw::bug 314120190110155933 "[::namespace current]::[::qw::methodname] - empty response list."; } ::set Response [::sargs .response_list $ResponseList]; # $_message_database cpp_database_safepoint; stats_increment "mothership_message_reply" 1; ::if {$rwb1_debug} {::puts "rwb1_debug,asynch_post_to_mothership,2000.99.0,Response==$Response";} ::return $Response; } method mothership_index_files_create {sargs} { ::set sargs [::sargs]; ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,mothership_index_files_create,1000.0";} ::foreach IndexPath $_mothership_index_path_list { ::set sargs [::sargs]; ::sargs::var::set sargs .path $IndexPath; ::sargs::var::set sargs .branch_order 256; ::sargs::var::set sargs .leaf_order 256; ::sargs::var::set sargs .schema.amounts [::list .count]; ::if {$rwb1_debug} {::puts "rwb1_debug,mothership_index_files_create,1000.1,indexpath==$IndexPath";} ::switch -glob -- $IndexPath { "/mothership/index/babyship_date" { # 0 ::sargs::var::set sargs .schema.key [::list string string]; } "/mothership/index/message_type_value" { # 1 ::sargs::var::set sargs .schema.key [::list string date string]; } "/mothership/index/message_type" { # 2 ::sargs::var::set sargs .schema.key [::list string date string]; } "/mothership/index/message_type/message_type_value" { # 3 ::sargs::var::set sargs .schema.key [::list string string date string]; } "/mothership/index/customer_id" { # 4 ::sargs::var::set sargs .schema.key [::list string date string]; } "/mothership/index/customer_id/message_type_value" { # 5 ::sargs::var::set sargs .schema.key [::list string string date string]; } "/mothership/index/customer_id/message_type" { # 6 ::sargs::var::set sargs .schema.key [::list string string date string]; } "/mothership/index/customer_id/message_type/message_type_value" { # 7 ::sargs::var::set sargs .schema.key [::list string string string date string]; } default { ::qw::throw [::sargs .error_id 314120190324135640 .text "mothership - unknown index path \"$IndexPath\"."]; } } ::if {$rwb1_debug} {::puts "rwb1_debug,mothership_index_files_create,1000.2,sargs==\n[::sargs::format $sargs]";} $_message_database cpp_file_create $sargs; ::if {$rwb1_debug} {::puts "rwb1_debug,mothership_index_files_create,1000.3,indexpath==$IndexPath";} } } method char_count {Text Char} { ::set Count 0; ::set Pos 0; ::while {1} { ::set Pos [::string first $Char $Text $Pos]; ::if {$Pos<=0} { ::break; } ::incr Count 1; ::incr Pos 1; } ::return $Count; } method message_database_rebuild_indexes {sargs} { /* { Delete all existing /motherhip/index/* indexes and builds them again from scratch. This is also the way we move forward from the older motherships when new indexes are added changed or removed. It was also used after importing a missing "gap", May 1st, 2022. We had a problem with no backup so we got the mothership running on any older copy of the database. Then we imported the "new" messages from that database into the original database. We could do this by simply inserting messages into the message file and then calling message_database_rebuild_indexes to make everything right. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.0";} ::set InodeFile [$_message_database cpp_file_factory]; ::qw::finally [::list $InodeFile cpp_destroy]; $InodeFile cpp_file_open .path "/"; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.1";} # ------------------------------------------------------------ # Delete all mothership indexes. # ------------------------------------------------------------ ::set InodeFile [$_message_database cpp_file_factory]; ::qw::finally [::list $InodeFile cpp_destroy]; $InodeFile cpp_file_open \ .path "/" \ .range.begin [::list string "/mothership/index"] \ .range.end [::list string "/mothership/index"] \ ; ::foreach Record [$InodeFile cpp_read_all_records] { ::set CarcassPath [::sargs::get $Record .data.path]; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.3,deleting $CarcassPath";} ::if {$CarcassPath eq "/mothership/index/mothership_date"} { /* { Index /mothership/index/mothership_date was in the original mothership but was never used. When we rebuild, the index will be deleted. We put out a message to see if/when that happens. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.4.0,deleting $CarcassPath";} } $_message_database cpp_file_delete .path $CarcassPath; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.4.1";} } # ------------------------------------------------------------ # Create all mothership index files. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.5.0";} mothership_index_files_create; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.5.1";} # ------------------------------------------------------------ # Traverse message file and rebuild all mothership index records. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.6";} ::set ProgressLimit [$_message_file cpp_record_count]; ::set Progress [::itcl::local ::QW::PROGRESS::OPERATION #auto \ .database_id [$_message_database cpp_database_id_get] \ .file [$_message_database cpp_database_path] \ .limit $ProgressLimit \ .operation "building message database indexes" \ .status "[$_message_database cpp_database_path] building indexes." \ ]; ::set ProgressAccumulator 0; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.7";} ::if {$_bad_message_check} { ::set BadMessageCount 0; ::set BadMessageList [::list]; } ::set RecordCount 0; ::for {::set Record [$_message_file cpp_record_first]} {[::sargs::size $Record]!=0} {::set Record [$_message_file cpp_record_next $Record];} { ::incr RecordCount 1; ::incr ProgressAccumulator 1; ::if {$ProgressAccumulator==109} { $Progress increment $ProgressAccumulator; ::set ProgressAccumulator 0; } ::set Message [::sargs::get $Record .data]; # ------------------------------------------------------------ # Delete records whose braces don't match. # ------------------------------------------------------------ ::if {$_bad_message_check} { ::if {![::qw::debugutil::braces_match .data $Record]} { ::lappend BadMessageList $Message; ::incr BadMessageCount 1; $_message_file cpp_record_delete .before $Record; ::continue; } } # ------------------------------------------------------------ # Eliminate .errorInfo fields. # ------------------------------------------------------------ /* { Caused lots of problems and did us no good. */ } ::if {0} { ::set ErrorInfoFieldList [::sargs::select_field .field .errorInfo .structure $Message]; ::if {[::llength $ErrorInfoFieldList]!=0} { ::if {$rwb1_debug} {::puts "rwb1_debug,ErrorInfoFieldList==$ErrorInfoFieldList";} ::foreach FieldPath $ErrorInfoFieldList { ::if {$rwb1_debug} {::puts "rwb1_debug,unsetting field $FieldPath.errorInfo";} ::set Text [::sargs::get $Message $FieldPath.errorInfo]; ::set LeftBraceCount [char_count $Text "{"]; ::set RightBraceCount [char_count $Text "}"]; ::if {$LeftBraceCount!=$RightBraceCount} { ::if {$rwb1_debug} {::puts "rwb1_debug,method message_is_ok,1000.8,Left==$LeftBraceCount,Right==$RightBraceCount,text==\n$Text";} } ::sargs::var::unset Message $FieldPath.errorInfo; } ::set Before $Record; ::sargs::var::set Record .data $Message; $_message_file cpp_record_write .before $Before .after $Record; } } # ------------------------------------------------------------ # Fix an old change to a message type. # ------------------------------------------------------------ ::set MessageType [::sargs::get $Message .message_type]; ::if {$MessageType eq "nv2_install_dialog"} { /* { Looks like we changed nv2_install_dialog to nv2_install_from_dialog at some point in the past. Unifying it here. */ } ::set Before $Record; ::sargs::var::set Record .data.message_type "nv2_install_from_dialog"; $_message_file cpp_record_write .before $Before .after $Record; } ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.8";} # ------------------------------------------------------------ # Insert the index records for this message. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.8.2";} insert_message_index_records .message $Message; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.8.3";} ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.9";} } ::if {$ProgressAccumulator!=0} { $Progress increment $ProgressAccumulator; ::set ProgressAccumulator 0; } ::if {$_bad_message_check} { ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.9.0,BadMessageCount==$BadMessageCount;";} ::set Handle [::open [::file join [::file dirname $_message_database_path] bad_message_list.txt] w+]; ::fconfigure $Handle -translation binary; ::puts -nonewline $Handle $BadMessageList; ::close $Handle; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.9.1";} } ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.10";} $_message_database cpp_database_safepoint; ::if {$rwb1_debug} {::puts "rwb1_debug,message_database_rebuild_indexes,1000.99";} } method mothership_get_message_type_value {sargs} { /* { Each message type can also have a value. qw_bug and qw_warning have bug_id and warning_id respectively. Each type's value is comewhat customer and by default as use the customer number. */ } ::set rwb1_debug 0; ::set Message [::sargs::get $sargs .message]; ::set MessageType [::sargs::get $Message .message_type]; ::if {[::sargs::get $Message .message_type_value] ne ""} { ::return [::sargs::get $Message .message_type_value]; } ::if {[::sargs::get $Message .error_id] ne ""} { ::return [::sargs::get $Message .error_id]; } ::if {$rwb1_debug} {::puts "rwb1_debug,mothership_get_message_type_value,1000.3.0,MessageType==$MessageType";} ::switch -- $MessageType { "qw_bug" { ::set MessageTypeValue [::sargs::get $Message .bug_exception.bug_id]; } "qw_warning" { ::set MessageTypeValue [::sargs::get $Message .warning.warning_id]; } "connection_create" { ::set MessageTypeValue [::sargs::get $Message .database_information.database_id]; } "excel_unknown_error" - "server_boot" - "service_hub_boot" - "nv2_install_workstation_from_server" - "nv2_install_from_dialog" { ::set MessageTypeValue [::sargs::get $Message .computer_information.customer_support_registration.customer_number]; } default { # 2.34.5 pgq was inventing new message types ::set MessageTypeValue [::sargs::get $Message .computer_information.customer_support_registration.customer_number]; #2.34.5 ::qw::throw [::sargs .error_id 314120190325163142 .text "invalid message type \"$MessageType\"."]; } } ::return $MessageTypeValue; } method insert_message_index_records {sargs} { /* { Takes a single message and uses it to update all message indexes, adding one record to each index. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.0";} ::set Message [::sargs::get $sargs .message]; ::set MothershipMessageId [::sargs::get $sargs .message.mothership.message_id]; ::set MothershipDate [::sargs::get $Message .mothership.ymdhms]; ::set BabyshipDate [::sargs::get $Message .babyship.ymdhms]; ::set CustomerId [::sargs::get $Message .computer_information.customer_support_registration.customer_number]; ::set MessageType [::sargs::get $Message .message_type]; ::set MessageTypeValue [mothership_get_message_type_value $sargs]; ::set Amounts [::list .count 1.0]; ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.1";} /* { Sort messages CustomerId - BugId - Message Type - bug, warning, all */ } ::foreach IndexPath $_mothership_index_path_list { ::set Key [::list]; ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.2";} ::switch -glob -- $IndexPath { "/mothership/index/babyship_date" { # 0 /* { Displays all messages by date. Be careful what you ask for. customer_id "" message_type "" message_value "" */ } ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.3";} ::set MessageType [::sargs::get $Message .message_type]; ::set Key [::list date $BabyshipDate string $MothershipMessageId]; } "/mothership/index/message_type_value" { # 1 /* { Displays all messages of a specified message type in date order. Use this sparingly because there could be a lot of messages of a particular type. Perhaps we should return a warning page if there are a lot of messages. Displays messages in date order. customer_id "" message_type "" message_value 3141xxxxxxxxxxxxxx */ } ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.4";} ::set Key [::list string $MessageTypeValue date $BabyshipDate string $MothershipMessageId]; } "/mothership/index/message_type" { # 2 /* { Displays all messages of a specified message type in date order. Use this sparingly because there could be a lot of messages of a particular type. Perhaps we should return a warning page if there are a lot of messages. Displays messages in date order. customer_id "" message_type bug message_value "" */ } ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.5";} ::set MessageType [::sargs::get $Message .message_type]; ::set Key [::list string $MessageType date $BabyshipDate string $MothershipMessageId]; } "/mothership/index/message_type/message_type_value" { # 3 /* { Displays all instances of a particular message type value. For example, displays all bugs of a specified bug_id, or connection_create for a particular customer_id. customer_id "" message_type bug message_value 3141yyyymmddhhmmss */ } ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.6";} ::set MessageType [::sargs::get $Message .message_type]; ::set Key [::list string $MessageType string $MessageTypeValue date $BabyshipDate string $MothershipMessageId]; } "/mothership/index/customer_id" { # 4 /* { For a specified customer, displays all messages in date order. customer_id nv999999 message_type "" message_value "" */ } ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.7";} ::set Key [::list string $CustomerId date $BabyshipDate string $MothershipMessageId]; } "/mothership/index/customer_id/message_type_value" { # 5 /* { For a specified customer, displays all messages in date order. customer_id nv999999 message_type "" message_value "" */ } ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.8";} ::set Key [::list string $CustomerId string $MessageTypeValue date $BabyshipDate string $MothershipMessageId]; } "/mothership/index/customer_id/message_type" { # 6 /* { For a specified customer_id, displays all messages of a specified message_type in message value order. For messages with the same value, display them in date order. For example, display all bugs for a specified customer. customer_id nv999999 message_type bug message_value "" */ } ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.9";} ::set MessageType [::sargs::get $Message .message_type]; ::set Key [::list string $CustomerId string $MessageType date $BabyshipDate string $MothershipMessageId]; } "/mothership/index/customer_id/message_type/message_type_value" { # 7 /* { Display all instances of a particular bug for a specified customer. customer_id nv999999 message_type bug message_value 3141yyyymmddhhmmss */ } ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.10";} ::set MessageType [::sargs::get $Message .message_type]; ::set Key [::list string $CustomerId string $MessageType string $MessageTypeValue date $BabyshipDate string $MothershipMessageId]; } default { ::qw::throw [::sargs .error_id 314120190324135641 .text "mothership - unknown index path \"$IndexPath\"."]; } } ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.11";} ::if {[::llength $Key]!=0} { /* { The key is empty if this message is not a hit in the current index being processed. We create the record here, including appending the mothership date and the message id to the end of each index record. The last index component, the mothership message id, allows us to load the message at any time. The date will ensure that the messages are always sorted by date when everything else matches. For example if we select and customer_is and bug_id, the multiple occurrences of that bug for that customer will be sorted by date. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.12";} ::set After [::list .key $Key .amounts $Amounts]; ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.13";} $_message_database cpp_file_record_insert .path $IndexPath .after $After; ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.14";} } } ::if {$rwb1_debug} {::puts "rwb1_debug,insert_message_index_records,1000.99";} } }