-
Notifications
You must be signed in to change notification settings - Fork 0
/
intramine_main.pl
3569 lines (3181 loc) · 113 KB
/
intramine_main.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
# intramine_main.pl: a round-robin request redirector, creating and using
# a "server swarm" of Perl services in separate processes to do the heavy lifting.
# The server swarm is started here, and stopped on exit, and responds well to an EXIT request.
# Page names and Perl program names for the pages are listed in
# /data/serverlist.txt,
# which is also used in swarmserver.pm to create the top navigation for our site.
# If the "Count" field for a server is greater than one, Count instances of the server will
# be created here running on different ports, and requests will be cycled through the running
# instances.
#
# A note on how requests are handled (this server is called "main" below, and the Search
# server (which shows a Search dialog and shows search results) is used as an example server).
# Request are matched up with servers based on the unique "Short name" of the
# server as listed in the third field for it in data/serverlist.txt, so if main here receives
# a request such as
# http://192.168.1.132:81/Search
# the request will be redirected to a running Search server, such as
# http://192.168.1.132:43128/Search
# This main server is *not* a two-way conduit for results, and communicates back to clients only with
# redirects in response to a page request. If a user issues a request such as "...:81/Search"
# just above to main running on port 81, then the request will be redirected to a running
# Search server, on port 43128 say, and "...:43128/Search" will show up in the user's
# browser address bar. A typical round robin server might send a request to the Search server,
# insist on receiving back the full response itself, and forward the results to the client, so
# the user would always see a single port number in the address bar (more typically the port
# isn't even shown, but remains constant).
# Anyway, this main server is typically under very light load, and just redirects to other servers
# that do the real work. The one drawback of this approach is that the user will see a
# variable port number, and any bookmarks made will contain that potentially variable port
# number. Hoops are jumped through to try to ensure that any wrong port numbers in bookmarks
# are automatically fixed with a redirect when detected. Specifically, any swarm server that
# receives a request for a different Short name will ask Main to redirect it if possible,
# and Main monitors a few ports above the ones currently in use in case one of those higher
# port numbers was ever involved in a favorite/bookmark.
#
# This server isn't quite a "dumb pipe" since it participates in the handling of signals
# (see BroadcastSignal() below).
# And it also helps coordinate planned maintenance outages, as happens for example when a
# Linker server decides it needs to go away for a couple of minutes to rebuild its in-memory
# hash of file names and folder paths in response to a folder rename: when such a signal is
# received, this server will instruct all running Linker servers to carry out the maintenance
# one at a time, so at least one Linker will be available at all times.
# To see that Linker maintenance example in detail, look for
# "MAINTENANCE_SERVER_EVENTS" in data/intramine_config.txt, and "folderrenamed"
# below and in intramine_linker.pl
#
# A note on port numbers.
# This program needs two port numbers from data/intramine_config.
# The first is 'INTRAMINE_MAIN_PORT', the port to use for
# this main service. And the second is 'INTRAMINE_FIRST_SWARM_SERVER_PORT', the first port number
# to use for the other services that are started here (the "server swarm"), in accordance with
# the listings in serverlist.txt.
# The default for main service port is 81, but if that's busy you could use 8080 or 8081.
# There can be many swarm servers, and they will use consecutive port numbers starting with
# one above the port number supplied. The default 43124 is probably safe for you. To look for
# a free range of ports you can try running "netstat -ab" at the command prompt as Admin.
# (See https://www.howtogeek.com/howto/28609/how-can-i-tell-what-is-listening-on-a-tcpip-port-in-windows/)
# You should allow for needing about 50 ports, if you can. To minimize the number of ports needed,
# work out how many servers you will actually be running, corresponding to the server and their
# counts in data/serverlist.txt, and adjust the TOTAL_SWARM_PORTS_TO_MONITOR number in
# data/intramine_config.txt to that number plus one (that's not slop, the extra one is needed
# to communicate with other computers if an application is being used for remote editing).
#
# START INTRAMINE
# It's simplest to start up IntraMine by running bats/START_INTRAMINE.bat. There is no need
# to run as administrator.
# STOP INTRAMINE
# Run bats/STOP_INTRAMINE.bat to stop all IntraMine services including this one.
# TEST INTRAMINE
# Put the servers you want to test in data/serverlist_for_testing.txt, set their Count to 1,
# and run
# bats/TEST_INTRAMINE.bat.
# Syntax check (your path is probably different):
# perl -c C:\perlprogs\IntraMine\intramine_main.pl
# Command line (see bats/START_INTRAMINE.bat for a handier way to run):
# perl C:\perlprogs\IntraMine\intramine_main.pl
use strict;
use warnings;
use utf8;
use Carp;
use URI::Escape;
use FileHandle;
use IO::Socket;
use IO::Select;
use Win32::Process 'STILL_ACTIVE';
use Path::Tiny qw(path);
use lib path($0)->absolute->parent->child('libs')->stringify;
use common;
use LogFile; # For logging - log files are closed between writes.
use intramine_config;
use win_wide_filepaths;
use intramine_websockets_client;
# "-t" on the command line means we are testing.
# $TESTING is used in ReceiveInfo() below to start the tests with RunAllTests()
# after all services have loaded.
# $TESTING is also used in StartServerSwarm() to start only the services that want testing,
# as listed in data/serverlist_for_testing.txt.
my $TESTING = shift @ARGV;
$TESTING ||= '';
if ($TESTING eq '-t')
{
$TESTING = 1;
}
else
{
$TESTING = 0;
}
my $SERVERNAME = 'IM_MAIN';
#$| = 1;
SetCommonOutput(\&Output); # common.pm
# Copy any new config files from /_copy_and_rename_to_data to /data.
CopyNewConfigFiles();
# Load data/intramine_config.txt. See eg $IMAGES_DIR just below.
LoadConfigValues();
my $port_listen = CVal('INTRAMINE_MAIN_PORT'); # default 81
# Note first port number is reserved for use by Opener's PowerShell server.
my $kSwarmServerStartingPort = CVal('INTRAMINE_FIRST_SWARM_SERVER_PORT') + 1; # default 43124 + 1
my $IGNOREEXITREQUEST = 0; # This should be 0 for main, to allow a clean restart.
my $kLOGMESSAGES = 0; # Log Output() messages
my $kDISPLAYMESSAGES = 0; # Display Output() messages in cmd window
#my $DriveLetter = CVal('DRIVELETTER');
my $IMAGES_DIR = FullDirectoryPath('IMAGES_DIR');
my $CSS_DIR = FullDirectoryPath('CSS_DIR');
my $JS_DIR = FullDirectoryPath('JS_DIR');
my $FONT_DIR = FullDirectoryPath('FONT_DIR');
my $FULL_ACCESS_STR = CVal('FULL_ACCESS_STR');
my $LogDir = FullDirectoryPath('LogDir');
my $StartTimeStamp = NiceToday();
my $logDate = DateTimeForFileName();
my $OutputLog = '';
if ($kLOGMESSAGES)
{
my $LogPath = $LogDir . "$SERVERNAME $logDate.txt";
print("LogPath: |$LogPath|\n");
MakeDirectoriesForFile($LogPath);
$OutputLog = LogFile->new($LogPath);
$OutputLog->Echo($kDISPLAYMESSAGES);
}
CheckNeededFoldersExist();
Output("Starting $SERVERNAME on port $port_listen, and swarm servers\n\n");
# Special handling for 'PERSISTENT' pages: at present only the 'Cmd' page is marked as
# PERSISTENT in /data/serverlist.txt, meaning it ignores an EXITEXITEXIT request so that it can
# continue to monitor and report when other servers have restarted. For a typical use see
# bats/elastic_stop_except_cmd_rebuild_start.bat, which:
# - calls intramine_stop.pl to pass an EXITEXITEXIT request to the main server, which is
# in turn passed on to all swarm servers - the Cmd servers ignore it
# - calls elastic_indexer.pl to rebuild the Elasticsearch search indexes
# - and then calls this program, intramine_main.pl, to restart all servers. When this program
# is starting up it will notice ( AnyCommandServerIsUp() ) if a Cmd page server is still
# running: if so, our main program here will postpone starting the Cmd servers until it has
# started all other swarm servers, and only then stop (with FORCEEXIT) and restart the
# Cmd page servers, or any other server you've marked as PERSISTENT in serverlist.txt.
# Having said all that, there is really no need to ever use this PERSISTENT notion, you're
# better off just stopping IntraMine completely, so please forgive me this one
# solution without a problem:)
my $CommandServerHasBeenNotified = 0;
my $CommandServersHaveBeenRestarted = 0;
# Some signals will knock out a server while it's doing heavy maintenance. For these, it's
# best to send the signal to the affected servers one by one, so only one server is out of
# commission at a time. Servers and signal names for those affected are listed in
# CVal('MAINTENANCE_SERVER_EVENTS'), see data/intramne_config.txt.
# To avoid confusion, signal names should be globally unique.
# Each affected server should send 'signal=backinservice&sender=SenderShortServerName'
# when the outage due to maintenance is over.
# For an example, search all of IntraMine's main Perl files for "folderrenamed".
LoadMaintenanceSignalsForServers();
# Start up all the swarm servers, based on the list in data/serverlist.txt.
StartServerSwarm($kSwarmServerStartingPort);
my $WebSockIsUp = 0;
# Listen for requests.
MainLoop($port_listen);
################### subs
# Print, to cmd line and log file.
sub Output {
my ($text) = @_;
if ($kLOGMESSAGES)
{
$OutputLog->Log("MAIN: $text");
}
if ($kDISPLAYMESSAGES)
{
print("MAIN: $text");
}
}
# Not all needed folders are shipped with IntraMine, the logs/ folder in particular is missing.
sub CheckNeededFoldersExist {
my $logDir = FullDirectoryPath('LogDir');
my $tempDir = $LogDir . 'temp/';
if (!MakeAllDirsWide($tempDir))
{
print("Error (will continue), could not make |$tempDir|\n");
}
}
{ ##### Server short names and associated signal names for heavy maintenance events.
# For tracking temporary server outages due to heavy maintenance, so they can be asked to do
# the maintenance one by one, and not asked to service a request while doing the maintenance.
# Any server doing such maintenance should do a
# RequestBroadcast('signal=backinservice&sender=SenderShortServerName')
# when back in service. Of course, this does nothing if only one instance of the service is running.
my %ServerShortNameForSignal; # $ServerShortNameForSignal{'folderrenamed'} = 'Linker';
# Track server short names under maintenance: cleared when all server instances are done.
my %ServerShortNameIsUnderMaintenance; # $ServerShortNameIsUnderMaintenance{'Linker'} = 1;
my %PortUnderMaintenance; # $PortUnderMaintenance{43124} = 1;
# For stepping through servers under maintenance to send them maintenance signals:
my %MaintenanceIndexForShortServerName; # 0..count = @{$PortsForShortServerNames{$shortName}}
# Note all maintenance signal names, in intramine_config.txt under 'MAINTENANCE_SERVER_EVENTS'.
# The format of the MAINTENANCE_SERVER_EVENTS value string is
# ShortServerName|signalName<spaces>ShortServerName|signalName...
# Eg
# MAINTENANCE_SERVER_EVENTS Linker|folderrenamed Other|signalName
sub LoadMaintenanceSignalsForServers {
# Eg MAINTENANCE_SERVER_EVENTS Linker|folderrenamed<space>OtherServer|signalValue
my $maintenanceStr = CVal('MAINTENANCE_SERVER_EVENTS');
my @serverSignalsArr = split(/\s+/, $maintenanceStr);
for (my $i = 0; $i < @serverSignalsArr; ++$i)
{
my @serverAndSignal = split(/\|/, $serverSignalsArr[$i]);
my $numFields = @serverAndSignal;
if ($numFields == 2)
{
$ServerShortNameForSignal{$serverAndSignal[1]} = $serverAndSignal[0];
}
}
}
sub SignalIndicatesMaintenanceOutage {
my ($signalName) = @_;
my $result = defined($ServerShortNameForSignal{$signalName}) ? 1 : 0;
return($result);
}
sub ShortServerNameForMaintenanceSignal {
my ($signalName) = @_;
my $result = defined($ServerShortNameForSignal{$signalName}) ?
$ServerShortNameForSignal{$signalName} : '';
return($result);
}
sub StartShortServerNameMaintenance {
my ($shortName) = @_;
# TEST ONLY
print("Start of maintenance for $shortName.\n");
$ServerShortNameIsUnderMaintenance{$shortName} = 1;
$MaintenanceIndexForShortServerName{$shortName} = -1; # pre-incremented by NextPort... below.
}
sub EndShortServerNameMaintenance {
my ($shortName) = @_;
# TEST ONLY
print("END of maintenance for $shortName.\n");
$ServerShortNameIsUnderMaintenance{$shortName} = 0;
}
sub ShortServerNameIsUndergoingMaintenance {
my ($shortName) = @_;
my $result = (defined($ServerShortNameIsUnderMaintenance{$shortName})
&& $ServerShortNameIsUnderMaintenance{$shortName} == 1);
return($result);
}
# Return next port for server short name (eg 'Viewer'), or 0.
# Stopped servers and servers undergoing maintenance are skipped.
sub NextPortForServerUnderMaintenance {
my ($shortName) = @_;
my $port = 0;
my $previousPortUnderMaintenance = 0;
if (ShortServerNameIsUndergoingMaintenance($shortName))
{
if ($MaintenanceIndexForShortServerName{$shortName} >= 0)
{
my $prevIndex = $MaintenanceIndexForShortServerName{$shortName};
$previousPortUnderMaintenance = IndexedPortForShortServerName($shortName, $prevIndex);
if ($previousPortUnderMaintenance != 0)
{
delete($PortUnderMaintenance{$previousPortUnderMaintenance});
}
}
my $numPortsTotal = NumServersTotalForShortName($shortName);
$MaintenanceIndexForShortServerName{$shortName} += 1;
my $index = $MaintenanceIndexForShortServerName{$shortName};
if ($numPortsTotal > 1)
{
my $previousIndex = $index;
my $foundNextPort = 0;
while ($index < $numPortsTotal && !$foundNextPort)
{
my $proposedPort = IndexedPortForShortServerName($shortName, $index);
if (ServerOnPortIsRunning($proposedPort))
{
$foundNextPort = 1;
}
else
{
$MaintenanceIndexForShortServerName{$shortName} += 1;
$index = $MaintenanceIndexForShortServerName{$shortName};
}
}
if ($foundNextPort)
{
$port = IndexedPortForShortServerName($shortName, $index);
}
}
else
{
if ($index == 0)
{
$port = IndexedPortForShortServerName($shortName, $index);
}
}
}
if ($port == 0)
{
EndShortServerNameMaintenance($shortName);
}
else
{
$PortUnderMaintenance{$port} = 1;
}
return($port);
}
# Call this to avoid sending requests to a server currently doing maintenance.
# Returns index >= 0 if some server associated with $shortName is currently doing
# maintenance, or -1.
sub IndexOfShortServerNameUnderMaintenance {
my ($shortName) = @_;
my $result = (ShortServerNameIsUndergoingMaintenance($shortName)) ?
$MaintenanceIndexForShortServerName{$shortName}: -1;
return($result);
}
sub PortIsUnderMaintenance {
my ($port) = @_;
my $result = defined($PortUnderMaintenance{$port}) ? 1 : 0;
return($result);
}
} ##### Server short names and associated signal names for heavy maintenance events.
{ ##### Swarm Server management
# Servers associated with pages: these include directly accessible servers with entries
# in the top navigation such as Search and Files, and also servers called by them to
# show results, such as Viewer (which is called by links in Search and Files to show a
# read-only view of a file). If a server doesn't have "BACKGROUND" in its config line
# in data/serverlist.txt, then it's a page server.
# Note "WEBSOCKET" also counts basically as a background server (single instance etc)
# and in addition only communicates by the ws:// (websockets) protocol, as opposed to http://.
# (And shouldn't it be called an "application" rather than a protocol? Never mind.)
my @ServerCommandLines; # One entry per server, eg "C:/Progs/Intramine/intramine_viewer.pl Search Viewer 81 43126"
my @ShortNameForCmdIndex; # $ShortNameForCmdIndex[7] = 'Reindex', used with %ShortNameIsForZombie
my @ServerCommandProgramNames; # Just the program name, eg "intramine_search.pl" for a $ServerCommandLines[] entry.
my @ServerCommandPorts; # Just the port used for a server.
my $SwarmServerStartingPort; # 'INTRAMINE_FIRST_SWARM_SERVER_PORT' plus one
my $SomeCommandServerIsRunning; # Postpone starting Cmd or other PERSISTENT page if it is stll running
my $NumServerPages; # Count of entries that appear in the top nav on each browser page: Search, File, Days etc
my @PageNames; # $PageNames[1] = 'Files' indexed by page
my @PageServerNames; # $PageServerNames[1][2] = 'intramine_open_with.pl' indexed by server
my %PageProcIDs; # proc ID, used when restarting and to check server process is still running
my %PageIndexForPageName; # $PageIndexForPageName{'Files'} = 1 indexed by page
my @ShortServerNames; # $ShortServerNames[1][2] = 'Opener' indexed by server
my %ShortServerNameForPort; # $ShortServerNameForPort{'43129'} = 'Viewer'
my %PageNameForShortServerName; # $PageNameForShortServerName{'Viewer'} = 'Search';
my %PageIsPersistent; # $PageIsPersistent{'Cmd'} = 1 means it survives a shutdown so it can continue monitoring status - this is mainly for the "Cmd" page
my @PageIndexIsPersistent; # $PageIndexIsPersistent[n] = 1 means associated Page is persistent, see line above
my @PageIndexForCommandLineIndex; # PageIndexForCommandLineIndex[4] = 1 for Files intramine_fileserver.pl to find out if it's persistent
# Note reserved services are mostly called "zombie" services below. Sorry about that.
# A 'zombie' service has a count of 0 in serverlist.txt. It won't be started when
# this Main service starts, but will be available for starting on the Status page.
# A port number will be reserved for it.
my %ShortNameIsForZombie; # $ShortNameIsForZombie{'Reindex'} = 1; undef if not a zombie.
my %PortForZombieShortName; # Used at startup to add listeners for zombie services.
# "Background" servers not associated with pages: names are UPPERCASE as listed in data/serverlist.txt.
# For example intramine_filewatcher.pl checks
# the File Watcher log file for changes, and calls out to Elasticsearch to index the changed
# files, after which it sends a "signal=filechange" signal that can be picked up by any
# server interested in file system changes (it's Status in this case).
# There is at most one of each Background server, regardless the Count field in serverlist.txt.
my @BackgroundCommandLines; # $BackgroundCommandLines[0] = "$scriptFullDir$BackgroundServerNames[$idx] $port_listen " . $currentPort;
my @BackgroundCommandProgramNames; # Like above, but just the program name, eg "intramine_filewatcher.pl"
my @BackgroundCommandPorts; # and just the port number for a $BackgroundCommandLines[] entry
my $NumBackgroundServers; # 0..up
my @BackgroundNames; # $BackgroundNames[0] = 'FILEWATCHER'
my @BackgroundServerNames; # $BackgroundServerNames[0] = 'intramine_filewatcher.pl'
my @ShortBackgroundServerNames; # $ShortBackgroundServerNames[0] = 'Watcher';
my %ShortBackgroundServerNameForPort; # $ShortBackgroundServerNameForPort{'43139'} = 'Watcher';
my %PortForShortBackgroundServerName; # $PortForShortBackgroundServerName{'Watcher'} = 43139;
my %BackgroundProcIDs; # proc ID, used when restarting and to check server process is still running
# For broadcasting to servers by name, it helps to know the server name for each command line. See BroadcastSignal() below.
my @ServerCommandLinePageNames;
my @BackgroundCommandLineNames;
# For WEBSOCKET servers (BACKGROUND servers that communicate using WebSockets only).
my %PortIsForWEBSOCKETServer; # $PortIsForWEBSOCKETServer{'43128'} = 1
my %IsWEBSOCKETServer; # $IsWEBSOCKETServer{$shortServerName} = 1
my $PrimaryWEBSOCKETPort; # See WebSocketServerPort() etc below
# For redirect based on short server name:
# Eg
# http://192.168.1.132:81/Viewer/?href=C:/perlprogs/mine/docs/domain%20name%20for%20intramine.txt&viewport=81&editport=81&rddm=1
# should be redirected to
# http://192.168.1.132:43125/Viewer/?href=C:/perlprogs/mine/docs/domain%20name%20for%20intramine.txt&viewport=81&editport=81&rddm=1
# where 43125 is a port number for a Viewer that is currently up.
my %PortsForShortServerNames; # $PortsForShortServerNames{'Viewer'}[portlist 0-up]
my %CurrentlyUsedIndexForShortServerNames; # $CurrentlyUsedIndexForShortServerNames{'Viewer'} = index into above portlist
my $HighestInitialServerPort; # $startingPort plus num servers started - 1
# For starting and stopping servers:
my %ServerPortIsRunning; # $ServerPortIsRunning{port number} = 1; if server on port number is running.
# Server monitoring: how many to start, how many actually started.
my $TotalServersWanted;
my $TotalServersStarted;
my %ServerPortIsStarting; # $ServerPortIsStarting{port number} = 1 if server on port is starting up. See ReceiveInfo().
my $DoingInitialStartup; # ==1 only during startup, for calling BroadcastAllServersUp()
# Main self-test.
my $MainSelfTest;
# Start all servers listed in data/serverlist.txt. The "Count" field in serverlist.txt
# determines how many of each server to start.
# First create cmd lines for all servers, then start them.
sub StartServerSwarm {
my ($startingPort) = @_;
$SwarmServerStartingPort = $startingPort;
my $currentPort = $startingPort;
my $webSocketPort = 0;
$TotalServersStarted = 0;
$DoingInitialStartup = 1;
SetMainSelfTest(0);
my $configFilePath = $TESTING ? FullDirectoryPath('TESTSERVERLISTPATH') : FullDirectoryPath('SERVERLISTPATH');
my $serverCount = LoadServerList($configFilePath);
#print("$serverCount server entries loaded from serverlist for $NumServerPages main pages.\n");
my $scriptFullPath = $0;
my $scriptFullDir = DirectoryFromPathTS($scriptFullPath);
CreateCommandLinesForServers(\$currentPort, $scriptFullDir, \$webSocketPort);
StartAllServers($currentPort);
}
sub CreateCommandLinesForServers {
my ($currentPort_R, $scriptFullDir, $webSocketPort_R) = @_;
# Command for page server [$pgIdx][$srv] (including PERSISTENT).
for (my $pgIdx = 0; $pgIdx < $NumServerPages; ++$pgIdx)
{
my $pageName = $PageNames[$pgIdx];
my $numServersForPage = @{$PageServerNames[$pgIdx]};
for (my $srv = 0; $srv < $numServersForPage; ++$srv)
{
my $shortName = $ShortServerNames[$pgIdx][$srv];
$ShortServerNameForPort{$$currentPort_R} = $shortName;
$PageNameForShortServerName{$shortName} = $pageName;
my $cmdLine = "$scriptFullDir$PageServerNames[$pgIdx][$srv] $pageName $shortName $port_listen $$currentPort_R";
push @ServerCommandLines, $cmdLine;
push @ShortNameForCmdIndex, $shortName;
push @ServerCommandProgramNames, $PageServerNames[$pgIdx][$srv];
push @ServerCommandPorts, $$currentPort_R;
push @ServerCommandLinePageNames, $pageName;
my $cmdIdx = @ServerCommandLines - 1;
$PageIndexForCommandLineIndex[$cmdIdx] = $pgIdx;
# For redirects, remember port list for each short server name.
push @{$PortsForShortServerNames{$shortName}}, $$currentPort_R;
$CurrentlyUsedIndexForShortServerNames{$shortName} = 0;
# Set server on current port as running (perhaps optimistic).
# Except for a zombie service, which isn't started on Main startup.
my $isStarting = (defined($ShortNameIsForZombie{$shortName})) ? 0 : 1;
SetServerPortIsRunning($$currentPort_R, $isStarting);
if (defined($ShortNameIsForZombie{$shortName}))
{
$PortForZombieShortName{$shortName} = $$currentPort_R;
}
else
{
AddNonListenerEntryForPortAndName($$currentPort_R, $shortName);
}
++$$currentPort_R;
}
}
# Command for BACKGROUND server.
# $NumBackgroundServers = @BackgroundNames;
# Start any WEBSOCKET server first.
for (my $loop = 1; $loop <= 2; ++$loop)
{
for (my $idx = 0; $idx < $NumBackgroundServers; ++$idx)
{
my $shortName = $ShortBackgroundServerNames[$idx];
if ( ($loop == 1 && ShortNameIsForWEBSOCKServer($shortName))
|| ($loop == 2 && !ShortNameIsForWEBSOCKServer($shortName)) )
{
$ShortBackgroundServerNameForPort{$$currentPort_R} = $shortName;
$PortForShortBackgroundServerName{$shortName} = $$currentPort_R;
# A background server doesn't have a "page" name since it isn't associated with
# a page, it just lurks in the background. So we send the $shortName in place of
# the page name, just to keep the interface simple.
my $cmdLine = "$scriptFullDir$BackgroundServerNames[$idx] $shortName $shortName $port_listen $$currentPort_R";
push @BackgroundCommandLines, $cmdLine;
push @BackgroundCommandProgramNames, $BackgroundServerNames[$idx];
push @BackgroundCommandPorts, $$currentPort_R;
push @BackgroundCommandLineNames, $BackgroundNames[$idx];
# Set server on current port as running (perhaps optimistic).
SetServerPortIsRunning($$currentPort_R, 1);
if (ShortNameIsForWEBSOCKServer($shortName))
{
$PortIsForWEBSOCKETServer{$$currentPort_R} = 1;
$$webSocketPort_R = $$currentPort_R;
SetWebSocketServerPort($$currentPort_R);
}
AddNonListenerEntryForPortAndName($$currentPort_R, $shortName);
++$$currentPort_R;
} # if first $loop and WEBSOCKET, or second $loop
} # for BACKGROUND servers
} # two $loops
# Reget $$webSocketPort_R, in case we are testing (see up around line 605);
$$webSocketPort_R = WebSocketServerPort();
# Revisit the command lines for all servers and put in " $$webSocketPort_R" at end.
for (my $i = 0; $i < @ServerCommandLines; ++$i)
{
$ServerCommandLines[$i] .= " $$webSocketPort_R";
}
for (my $i = 0; $i < @BackgroundCommandLines; ++$i)
{
$BackgroundCommandLines[$i] .= " $$webSocketPort_R";
}
}
sub StartAllServers {
my ($currentPort) = @_;
# Postpone 'persistent' (command) server starts if any are running.
$SomeCommandServerIsRunning = AnyCommandServerIsUp();
# Start the Page servers, from $PageIndexForCommandLineIndex[].
my $numServers = @ServerCommandLines;
my $numServersStarted = 0;
for (my $i = 0; $i < $numServers; ++$i)
{
my $pgIdx = $PageIndexForCommandLineIndex[$i];
my $isPersistent = $PageIndexIsPersistent[$pgIdx];
if (!$isPersistent || !$SomeCommandServerIsRunning)
{
my $shortName = $ShortNameForCmdIndex[$i];
my $isZombie = (defined($ShortNameIsForZombie{$shortName})) ? 1 : 0;
if (!$isZombie)
{
# TEST ONLY
#print("STARTING '$ServerCommandLines[$i]' \n");
Output(" STARTING '$ServerCommandLines[$i]' \n");
my $proc;
Win32::Process::Create($proc, $ENV{COMSPEC}, "/c $ServerCommandLines[$i]", 0, 0, ".")
|| die ServerErrorReport();
$PageProcIDs{$ServerCommandLines[$i]} = $proc;
++$numServersStarted;
}
}
else
{
Output("(Command server, skipping for now since it's already running.)\n");
}
}
Output("$numServersStarted out of $numServers page servers started\n------------\n");
$TotalServersWanted = $numServers;
# Start one of each BACKGROUND (or WEBSOCKET) server.
$numServers = @BackgroundCommandLines;
for (my $i = 0; $i < $numServers; ++$i)
{
# TEST ONLY
#print("STARTING '$BackgroundCommandLines[$i]' \n");
Output(" STARTING '$BackgroundCommandLines[$i]' \n");
my $proc;
Win32::Process::Create($proc, $ENV{COMSPEC}, "/c $BackgroundCommandLines[$i]", 0, 0, ".")
|| die ServerErrorReport();
$BackgroundProcIDs{$BackgroundCommandLines[$i]} = $proc;
++$numServersStarted;
}
Output("$numServers background servers started\n------------\n");
$TotalServersWanted += $numServers;
$HighestInitialServerPort = $currentPort - 1;
}
sub SwarmServerFirstPort {
return($SwarmServerStartingPort);
}
# Load data/serverlist.txt. Using '|' to mean 'one or more tabs', file format there is:
# Count|Page Name|Unique short name|Perl program name(*optional*|PERSISTENT or BACKGROUND or WEBSOCKET)
# Count is how many of each server. The second entry is the name of the associated web page,
# third is a unique short name for the server,
# fourth entry is the name of associated Perl program that runs the server for the page.
# "intramine_search.pl" shows the Search page, with search form and (Elasticsearch) search results.
# "intramine_viewer.pl" shows read-only views of files, mostly using codemirror (cm).
# "intramine_editor.pl" opens an editable view of a file using the CodeMirror editor etc.
# The "Cmd" page is special, associated server can stay running response to a restart request so that
# it can continue monitoring during the restart. The serverlist.txt entry for it is
# Cmd Cmd intramine_commandserver.pl PERSISTENT
# with 'PERSISTENT' signalling that it should be treated specially. See $CommandServerHasBeenNotified etc.
# An entry with trailing 'BACKGROUND' signals a server that has no top navigation entry or association
# with same, typically just lurking in the background doing maintenance. Eg
# FILEWATCHER Watcher intramine_filewatcher.pl BACKGROUND
# monitors the file system for changes, and asks Elasticsearch to reindex changed/new files.
# See serverlist.txt.
sub LoadServerList {
my ($configFilePath) = @_;
my $count = 0;
my $zombieCount = 0;
if (-f $configFilePath)
{
my $fileH = FileHandle->new("$configFilePath") or die("No config file found at |$configFilePath|!\n");
my $line;
my $pageIndex = -1;
my %pageNameSeen;
# Load the WS service line first and always.
my $webSocketLine = '1 WEBSOCKETS WS intramine_websockets.pl WEBSOCKET';
# FOR TESTING ONLY, start the WS service in a separate cmd window if 1.
my $runWSServerSeparately = 0;
if (!$runWSServerSeparately) # business as usual
{
LoadOneServer($webSocketLine, \$count, \$pageIndex, \%pageNameSeen, 0);
}
else # Make sure the names and numbers are right!
{
$IsWEBSOCKETServer{'WS'} = 1;
SetWebSocketServerPort('43140');
$PortIsForWEBSOCKETServer{'43140'} = 1;
$ShortBackgroundServerNameForPort{'43140'} = 'WS';
$PortForShortBackgroundServerName{'WS'} = '43140';
}
# Aug 2021 the SSE server has been dropped. Don't start it.
while ($line = <$fileH>)
{
chomp($line);
if (length($line) && $line !~ m!^\s*(#|$)!) # skip blank lines and comments.
{
my $isZombie = ($line =~ m!^0\s!); # Zero count means don't start yet.
# Avoid loading the WS service twice. And avoid loading the SSE server always.
if ($line !~ m!intramine_websockets\.pl! && $line !~ m!intramine_SSE\.pl!)
{
LoadOneServer($line, \$count, \$pageIndex, \%pageNameSeen, $isZombie);
if ($isZombie)
{
++$zombieCount;
}
}
}
}
close $fileH;
if ($count == 0)
{
die("ERROR could not load anything useful from config file |$configFilePath|!\n");
}
else
{
$NumServerPages = @PageNames;
$NumBackgroundServers = @BackgroundNames;
}
}
else
{
die("No config file found at |$configFilePath|!\n");
}
my $trueStartCount = $count - $zombieCount;
return($trueStartCount);
}
sub LoadOneServer {
my ($line, $countR, $pageIndexR, $pageNameSeenH, $isZombie) = @_;
my @fields = split(/\t+/, $line); # Split on one or more tabs
my $instanceCount = $fields[0]; # Note this is 0 if $isZombie
my $pageName = $fields[1];
my $shortServerName = $fields[2]; # for %ShortServerNameForPort, eventually
my $serverProgramName = $fields[3];
my $specialType = (defined($fields[4])) ? $fields[4]: '';
if ($shortServerName eq 'Main')
{
# Main entry just triggers a self-test if its Count field is positive.
if ($instanceCount > 0)
{
SetMainSelfTest(1);
# Fudge up an entry for intramine_test_main.pl.
my $mainTestProgram = CVal('INTRAMINE_TEST_SERVICE');
my $mainTestShortname = CVal('INTRAMINE_TEST_NAME');
$line = "";
$instanceCount = 2; # Run two to test round robin.
$pageName = $mainTestShortname;
$shortServerName = $pageName;
$serverProgramName = $mainTestProgram;
$specialType = '';
}
}
# 'BACKGROUND' programs do not correspond to pages, and have no web interface.
# Only one of each is started, and they do not appear in the navigation at top of page.
# A WEBSOCKET program is a BACKGROUND program that communicates only with WebSockets.
if ($specialType eq 'BACKGROUND' || $specialType eq 'WEBSOCKET')
{
push @BackgroundNames, $pageName;
push @BackgroundServerNames, $serverProgramName;
push @ShortBackgroundServerNames, $shortServerName;
if ($specialType eq 'WEBSOCKET')
{
$IsWEBSOCKETServer{$shortServerName} = 1;
}
}
else # a regular Page server, main entry will show up in nav bar.
{
if (!defined($pageNameSeenH->{$pageName}))
{
$pageNameSeenH->{$pageName} = 1;
++$$pageIndexR;
push @PageNames, $pageName;
$PageIndexForPageName{$pageName} = $$pageIndexR;
}
my $currPageIndex = $PageIndexForPageName{$pageName};
if ($specialType eq 'PERSISTENT')
{
$PageIsPersistent{$pageName} = 1; # eg "Cmd" server, will ignore regular 'EXITEXITEXIT' requests so it can monitor during restart
$PageIndexIsPersistent[$currPageIndex] = 1;
}
elsif (!defined($PageIndexIsPersistent[$currPageIndex]))
{
$PageIndexIsPersistent[$currPageIndex] = 0;
}
my $actualCount = ($instanceCount > 0) ? $instanceCount: 1;
for (my $j = 0; $j < $actualCount; ++$j)
{
push @{$PageServerNames[$currPageIndex]}, $serverProgramName;
push @{$ShortServerNames[$currPageIndex]}, $shortServerName;
}
if ($isZombie)
{
$ShortNameIsForZombie{$shortServerName} = 1;
}
}
++$$countR; # includes backgrounds, just used to report count of servers seen
}
sub ServerErrorReport{
print Win32::FormatMessage( Win32::GetLastError() );
return 1;
}
# This "Stop" is ignored by Cmd page servers, so they can keep running when
# the server swarm and this server are stopped and restarted from a particular
# Cmd page somewhere. As mentioned at the top of this file, you can safely ignore this "feature."
sub StopAllSwarmServers {
# TEST ONLY
print("Asking all servers to stop.\n");
my $srvrAddr = ServerAddress();
# Page servers.
my $numServers = @ServerCommandLines;
for (my $i = 0; $i < $numServers; ++$i)
{
my $port = $ServerCommandPorts[$i];
AskSwarmServerToExit($port, $srvrAddr);
}
# Background servers.
$numServers = @BackgroundCommandLines;
for (my $i = 0; $i < $numServers; ++$i)
{
my $port = $BackgroundCommandPorts[$i];
if (!PortIsForWEBSOCKServer($port))
{
AskSwarmServerToExit($port, $srvrAddr);
}
}
# Do the WebSockets server last.
for (my $i = 0; $i < $numServers; ++$i)
{
my $port = $BackgroundCommandPorts[$i];
if (PortIsForWEBSOCKServer($port))
{
AskSwarmServerToExit($port, $srvrAddr);
}
}
}
sub AskSwarmServerToExit {
my ($portNumber, $serverAddress) = @_;
if (ServerOnPortIsRunning($portNumber))
{
Output("Attempting to stop $serverAddress:$portNumber\n");
if (PortIsForWEBSOCKServer($portNumber))
{
WebSocketSend('EXITEXITEXIT');
Output("Exit request sent to $serverAddress:$portNumber\n");
SetServerPortIsRunning($portNumber, 0);
}
else
{
my $remote = IO::Socket::INET->new(
Proto => 'tcp', # protocol
PeerAddr=> "$serverAddress", # Address of server
PeerPort=> "$portNumber" # port of swarm server, default is 43124..up
) or (ServerErrorReport() && return);
print $remote "GET /?EXITEXITEXIT=1 HTTP/1.1\n\n";
close $remote;
Output("Exit request sent to $serverAddress:$portNumber\n");
# A persistent server such as "Cmd" will not stop for this request.
my $numServers = @ServerCommandLines;
my $isPersistent = 0;
for (my $i = 0; $i < $numServers; ++$i)
{
my $port = $ServerCommandPorts[$i];
if ($port == $portNumber)
{
my $pgIdx = $PageIndexForCommandLineIndex[$i];
$isPersistent = $PageIndexIsPersistent[$pgIdx];
last;
}
}
if (!$isPersistent)
{
SetServerPortIsRunning($portNumber, 0);
}
}
}
else
{
Output("$serverAddress:$portNumber has already been asked to stop.\n");
}
}
# This "ForceStop" will stop all swarm servers, including Cmd page intramine_commandserver.pl servers.
sub ForceStopAllSwarmServers {
print("Forcing all servers to stop.\n");
my $srvrAddr = ServerAddress();
# Page servers.
my $numServers = @ServerCommandLines;
for (my $i = 0; $i < $numServers; ++$i)
{
my $port = $ServerCommandPorts[$i];
print("Forcing stop of Page server on port $port\n");
ForceStopServer($port, $srvrAddr);
}
# Background servers.
$numServers = @BackgroundCommandLines;
for (my $i = 0; $i < $numServers; ++$i)
{
my $port = $BackgroundCommandPorts[$i];
if (!PortIsForWEBSOCKServer($port))
{
print("Forcing stop of BACKGROUND server on port $port\n");
ForceStopServer($port, $srvrAddr);
}
}
# Do the WebSockets server last.
for (my $i = 0; $i < $numServers; ++$i)
{
my $port = $BackgroundCommandPorts[$i];
if (PortIsForWEBSOCKServer($port))
{
print("Forcing stop of WebSockets server on port $port\n");
ForceStopServer($port, $srvrAddr);
}
}
}
sub ForceStopServer {
my ($portNumber, $serverAddress) = @_;
# TEST ONLY
print("Attempting to FORCE stop $serverAddress:$portNumber\n");
if (ServerOnPortIsRunning($portNumber))
{
Output("Attempting to FORCE stop $serverAddress:$portNumber\n");
if (PortIsForWEBSOCKServer($portNumber))
{
WebSocketSend('FORCEEXIT');
Output("FORCEEXIT sent to $serverAddress:$portNumber\n");
SetServerPortIsRunning($portNumber, 0);
}
else
{
my $remote = IO::Socket::INET->new(
Proto => 'tcp', # protocol
PeerAddr=> "$serverAddress", # Address of server
PeerPort=> "$portNumber" # port of server typ. 43124..up
) or (ServerErrorReport() && return);
print $remote "GET /?FORCEEXIT=1 HTTP/1.1\n\n";
close $remote;
Output("FORCEEXIT sent to $serverAddress:$portNumber\n");
SetServerPortIsRunning($portNumber, 0);
}
}
else
{
Output("$serverAddress:$portNumber has already been stopped.\n");
}
}
# BroadcastSignal():
# Send message to some or all IntraMine servers, in response to a swarmserver.pm#RequestBroadcast().
# TLDR; $formH->{'signal'} must be defined for signal to be sent, and $msg should start
# off with '/?signal=someSignal' in order for some recipient to notice that it's an incoming signal.
#
# Recipients, and whether or not to even send the signal, are determined by $formH entries:
# $formH->{'signal'} must be defined in order to send the signal.
# $formH->{'name'} can optionally be defined to limit the recipients:
# $formH->{'name'} == 'PageServers' will send to non-background servers
# $formH->{'name'} == 'BackgroundServers' will send to background "background" servers
# $formH->{'name'} == entry in @ServerCommandLinePageNames will send to just servers associated with that page
# $formH->{'name'} == entry in @BackgroundCommandLineNames will send to just that background server
#
# The "short name" for each swarm server is appended here to the $msg payload, eg
# 'name=Upload' when sending to an instance of intramine_uploader.pl. ("Short" names are
# in the third column of data/serverlist.txt.)
#
# A BroadcastSignal() can originate here (see BroadcastDateHasChanged() below), but it is more often
# called in response to a request to forward a signal as received from elsewhere. The line
# $RequestAction{'signal'} = \&BroadcastSignal; # signal=anything
# near the top of MainLoop() sets up the signal handler.
#
# Typically it's a server other than this main one that sends the signal.
# For example, BroadcastOverdueCount() in intramine_todolist.pl sends off
# "signal=todoCount&count=$overdueCount&name=PageServers"
# to this main server. In initial processing here, the parameters 'signal', 'count' etc
# are put in $formH, so the contents of $obj and $formH as received here from another
# server are essentially the same. The 'name=PageServers' param ends up in $formH as
# $formH->{'name'} == 'PageServers', resulting in a broadcast to all page servers.
#
# If the sender name is important, supply it as 'sender=ShortServerName', eg 'sender=Viewer'.
#
# Some signals imply that a server will be out of action carrying out maintenance for a while.
# For these signals, if there are two or more instances of the server running we signal them
# to carry out the maintenance one at a time, to avoid a total service outage.
#
# TODO currently there is no way to send a signal to a top level servers such as Search without
# also sending the signal to its associated second level servers (Viewer Opener Editor Linker).
# This is inefficient, but a server that doesn't want a signal can just ignore it.
#
# Note WEBSOCKET servers are skipped, they only talk through ws:// connections, not http://.