![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to modcon CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / ChivanetModcon|
Return to modcon CVS log | Up to [Coherent Logic Development] / ChivanetModcon |
1.1 snw 1: #!/usr/bin/env perl
2:
3: #
4: # ChivaNet Moderator Console
5: # Copyright (C) 2025 Coherent Logic Development LLC
6: #
1.8 ! snw 7: # $Id: modcon,v 1.7 2025/03/10 15:31:54 snw Exp $
1.1 snw 8: #
9: # Author: Serena Willis <snw@coherent-logic.com>
10: #
11: # Licensed AGPL-3.0
12: #
1.8 ! snw 13: # $Log: modcon,v $
! 14: # Revision 1.7 2025/03/10 15:31:54 snw
! 15: # Test
1.7 snw 16: #
17: # Revision 1.6 2025/02/04 18:55:12 snw
18: # Updates
19: #
1.6 snw 20: # Revision 1.5 2025/02/01 03:17:46 snw
21: # Fix session list
22: #
1.5 snw 23: # Revision 1.4 2025/01/31 19:41:00 snw
24: # Move to a UNIX UI paradigm
25: #
1.4 snw 26: # Revision 1.3 2025/01/31 15:39:06 snw
27: # Minor fixes
28: #
1.3 snw 29: # Revision 1.2 2025/01/31 13:38:51 snw
30: # Initial basic functions working
31: #
1.2 snw 32: # Revision 1.1.1.1 2025/01/30 19:16:06 snw
33: # Initial commit
34: #
1.1 snw 35: #
36:
37: use REST::Client;
38: use JSON;
39: use Data::Dumper;
40: use Term::ReadKey;
1.4 snw 41: use Getopt::Long;
1.6 snw 42: use Text::Glob qw(match_glob);
1.1 snw 43:
1.4 snw 44: my $sso_account = '';
1.1 snw 45: my $apikey = '';
46: my $online = 0;
47: my $modcon_version = '0.0.1';
48: my $cnclient = '';
49: my $wchar = '';
50: my $hchar = '';
51: my $wpixels = '';
52: my $hpixels = '';
1.2 snw 53: my $account = '';
1.4 snw 54: my $mode = '---';
55: my $user = '---';
56: $site = '';
57:
58: sub list_directories {
59: return ('sso', 'ras');
60: }
1.2 snw 61:
1.1 snw 62: sub list_sso_users {
1.4 snw 63: $cnclient->GET("/chivanet/users");
1.1 snw 64: my $json = $cnclient->responseContent();
65: my $hashref = decode_json($json);
66:
67: if($hashref->{ok} == 1) {
68: my $arrayref = $hashref->{users};
1.4 snw 69: my @users = @{$arrayref};
70:
71: return @users;
1.1 snw 72: }
73: else {
74: print "RPC error\n";
1.4 snw 75: return ();
1.1 snw 76: }
77: }
78:
79:
1.2 snw 80: sub select_sso_user {
81: my($id) = @_;
82:
83: $cnclient->GET("/chivanet/validate_user?id=$id");
84: my $json = $cnclient->responseContent();
85: my $hashref = decode_json($json);
86:
87: if($hashref->{exists} == 1) {
88:
89: $cnclient->GET("/chivanet/user?id=$id");
90: my $json = $cnclient->responseContent();
91: $account = decode_json($json);
1.4 snw 92:
1.2 snw 93: return $id;
94: }
95: else {
96: return "---";
1.3 snw 97: }
1.2 snw 98: }
99:
100: sub select_ras_user {
101: my($id) = @_;
102:
103: $cnclient->GET("/chivanet/validate_sn?id=$id");
104: my $json = $cnclient->responseContent();
105: my $hashref = decode_json($json);
106:
107: if($hashref->{exists} == 1) {
108: return $id;
109: }
110: else {
111: return "---";
112: }
113: }
114:
115: sub trace_ras_sn {
116: my($user) = @_;
117:
118: $cnclient->GET("/chivanet/trace_sn?id=$user");
119: my $json = $cnclient->responseContent();
120: my $hashref = decode_json($json);
121: my $record = $hashref->{account};
122: my $result = $record->{id};
123:
124: print "RAS screen name $user belongs to SSO account $result; switching to SSO mode\n";
1.3 snw 125: return $result;
1.2 snw 126: }
127:
128: sub list_ras_sessions {
129: $cnclient->GET("/chivanet/ras_sessions");
130: my $json = $cnclient->responseContent();
131: my $hashref = decode_json($json);
132: my $sessions = $hashref->{sessions};
133: my $arrayref = $sessions->{sessions};
1.5 snw 134: my @result = ();
1.2 snw 135:
136: foreach my $session (@{$arrayref}) {
1.5 snw 137: push(@result, $session->{id});
1.2 snw 138: }
139:
1.5 snw 140: return @result;
1.2 snw 141: }
142:
143: sub list_ras_screennames {
144: my($id) = @_;
1.5 snw 145:
146: my @result = ();
147: $cnclient->GET("/chivanet/user_ras_screen_names?id=$id");
1.2 snw 148: my $json = $cnclient->responseContent();
149: my $hashref = decode_json($json);
150: my $arrayref = $hashref->{screen_names};
1.5 snw 151:
152: foreach my $item (@{$arrayref}) {
153: push(@result, $item->{screen_name});
154: }
155:
1.2 snw 156:
1.5 snw 157: return @result;
1.4 snw 158: }
1.2 snw 159:
1.4 snw 160: sub list_ras_users {
1.3 snw 161:
1.5 snw 162: my @result = ();
1.4 snw 163:
1.5 snw 164: $cnclient->GET("/chivanet/all_ras_screen_names");
165: my $json = $cnclient->responseContent();
166: my $hashref = decode_json($json);
167:
168: if($hashref->{ok} == 0) {
169: print "RPC error\n";
170: return @result;
171: }
172:
173: my $arrayref = $hashref->{screen_names};
174:
175: foreach my $entryref (@{$arrayref}) {
176: push(@result, $entryref->{id});
177: }
178:
179: return @result;
1.2 snw 180: }
181:
182: sub print_sso_user {
183: my $act = $account->{account};
184:
185: print "\n";
186: print "Username : $act->{id}\n";
187: print "Real Name : $act->{last_name}, $act->{first_name}\n";
188: print "Display Name : $act->{display_name}\n";
189: print "Pronouns : $act->{pronouns}\n";
190: print "Profile Image : https://chivanet.org$act->{profile_photo}\n";
191: print "E-Mail Address : $act->{email}\n";
192: print "Permission Level : $act->{perm_level}\n";
193: print "Created : $act->{create_ts}\n";
194: print "Banned : $act->{mod_banned}\n\n";
195: }
196:
197: sub print_ras_user {
198: my($id) = @_;
199:
200: $cnclient->GET("/chivanet/sn_status?id=$id");
201: my $json = $cnclient->responseContent();
202: my $hashref = decode_json($json);
203: my $status = $hashref->{status};
204: my $online = "offline";
205:
206: if($status->{online} == 1) {
207: $online = "online";
208: }
209:
210: print "\n";
211:
212:
213: if($online eq "online") {
214: my $sess = $status->{session};
215: my $service = 'AIM';
216:
217: if($sess->{is_icq} == 1) {
218: $service = 'ICQ';
219: }
220:
221: if($sess->{idle_seconds} > 0) {
222: $online = "idle";
223: }
224:
225: print "Screen Name : $id [$online]\n";
226: print "Service : $service\n";
227: if($online eq "online") {
228: print "Time Online (secs): $sess->{online_seconds}\n";
229: }
230: else {
231: print "Time Idle (secs) : $sess->{idle_seconds}\n";
232: }
233: print "Away Message : $sess->{away_message}\n\n";
234: }
235: else {
236: print "Screen Name : $id [$online]\n\n";
1.5 snw 237: }
1.2 snw 238:
239: }
240:
241: sub send_im {
242: my($user, $msgbody) = @_;
243:
244: print "sending message \"$msgbody\" to $user...";
245:
246: my $msg = "<font color=red><strong>[ChivaNet Support]:</strong></font> $msgbody";
247:
248: $cnclient->GET("/chivanet/send_im?from=ChivaNet&to=$user&message=$msg");
249: my $json = $cnclient->responseContent();
250: my $hashref = decode_json($json);
251:
252: if($hashref->{status} == 1) {
253: print "[OK]\n";
254: }
255: else {
256: print "[FAIL]\n";
257: }
258: }
259:
1.5 snw 260: sub ls {
1.6 snw 261: my ($description, $match, @entries) = @_;
262:
263: if($match eq "") {
264: $match = '*';
265: }
1.5 snw 266:
1.6 snw 267: print "Directory of [$description] matching \'$match\':\n\n";
268:
1.5 snw 269: my @sorted = sort(@entries);
270: my $maxlen = 0;
1.6 snw 271:
1.5 snw 272: foreach my $entry (@sorted) {
273: my $len = length($entry);
274: if ($len > $maxlen) {
275: $maxlen = $len;
276: }
277: }
1.6 snw 278:
1.5 snw 279: $maxlen = $maxlen + 2;
1.6 snw 280:
1.5 snw 281: my $ct = $#sorted + 1;
282: foreach my $entry (@sorted) {
1.6 snw 283: if(match_glob($match, $entry)) {
284: if($col + $maxlen >= $wchar) {
285: print "$entry\n";
286: $col = 0;
287: }
288: else {
289: printf("%-$maxlen\s", $entry);
290: $col = $col + $maxlen;
291: }
1.5 snw 292: }
293: else {
1.6 snw 294: $ct = $ct - 1;
295: }
296: }
1.5 snw 297:
1.6 snw 298: print "\n\n$ct matching items in directory\n";
1.5 snw 299: }
300:
1.1 snw 301: sub prompt {
302:
303: my $rawcmd = '';
1.4 snw 304: my $pmode = $mode;
305: my @path = ();
306:
1.1 snw 307: while (1) {
1.4 snw 308: $pmode = lc $mode;
309: my $prompt = '';
310: if($pmode ne "---") {
311: if($user eq '---') {
312: $prompt = "$sso_account\@$site:[/$pmode]\$ ";
313: }
314: else {
315: $prompt = "$sso_account\@$site:[/$pmode/$user]\$ ";
316: }
317: }
318: else {
319: $prompt = "$sso_account\@$site:[/]\$ ";
320: }
321: print $prompt;
1.1 snw 322: my $line = <STDIN>;
323: chomp($line);
324: $rawcmd = $line;
325:
326: my @cmd = split(' ', $rawcmd);
327:
1.5 snw 328: if ($cmd[0] eq "exit" || $cmd[0] eq "logout" || $cmd[0] eq "quit" || $cmd[0] eq "bye" || $cmd[0] eq "lo") {
1.1 snw 329: return;
330: }
1.4 snw 331: elsif ($cmd[0] eq "pwd") {
332: my $pstr = join('/', @path);
333: print "/$pstr\n";
334: }
335: elsif ($cmd[0] eq "cd") {
336: my $abspath = false;
337:
338: if($cmd[1] eq "..") {
339: if(@path) {
340: if($#path == 1) {
341: $user = "---";
342: @path = ($pmode);
343: }
344: elsif($#path == 0) {
345: $mode = "---";
346: @path = ();
347: }
348: }
349: else {
350: print "already in root directory\n";
351: }
1.2 snw 352: }
353: else {
1.4 snw 354: my @oldpath = @path;
355: @path = split('/', $cmd[1]);
356:
357: if(substr($cmd[1], 0, 1) eq '/') {
358: $abspath = true;
359: shift @path;
360: }
361:
362: if($abspath eq true || !@oldpath) {
363: if($#path == 0) {
364: # mode, no user
365: if($path[0] eq "sso") {
366: $mode = "SSO";
367: $user = "---";
368: @path = ('sso');
369: }
370: elsif($path[0] eq "ras") {
371: $mode = "RAS";
372: $user = "---";
373: @path = ('ras');
374: }
375: else {
376: print "$path[0]: no such directory exists\n";
377: @path = @oldpath;
378: }
379: }
380: elsif($#path == 1) {
381: # mode and user
382: if($path[0] eq "sso") {
383: $user = select_sso_user($path[1]);
384: if($user eq "---") {
385: print "$path[1]: no such file exists in $pmode\n";
386: @path = @oldpath;
387: }
388: else {
389: $mode = "SSO";
390: @path = ('sso', $user);
391: }
392: }
393: elsif($path[0] eq "ras") {
394: $user = select_ras_user($path[1]);
395: if($user eq "---") {
396: print "$path[1]: no such file exists in $pmode\n";
397: @path = @oldpath;
398: }
399: else {
400: $mode = "RAS";
401: @path = ('ras', $user);
402: }
403: }
404: else {
405: print "$path[0]: no such directory exists\n";
406: @path = @oldpath;
407: }
408: }
409: else {
410: if($cmd[1] eq '/') {
411: $mode = '---';
412: $user = '---';
413: @path = ();
414: }
415: else {
416: print "cd: invalid path specification\n";
417: @path = @oldpath;
418: }
419: }
1.2 snw 420: }
421: else {
1.4 snw 422: if($#oldpath == 1) {
423: print "invalid path specification\n";
424: @path = @oldpath;
425: }
426: else {
427: if($#path == 0) {
428: if($pmode eq "sso") {
429: $user = select_sso_user($path[0]);
430: if($user eq "---") {
431: print "$path[0]: no such file exists in $pmode\n";
432: @path = @oldpath;
433: }
434: else {
435: $mode = "SSO";
436: @path = ('sso', $user);
437: }
438: }
439: elsif($pmode eq "ras") {
440: $user = select_ras_user($path[0]);
441: if($user eq "---") {
442: print "$path[0]: no such file exists in $pmode\n";
443: @path = @oldpath;
444: }
445: else {
1.6 snw 446: $mode = "RAS";
447: @path = ('ras', $user);
1.4 snw 448: }
449: }
450: else {
451: print "$path[0]: no such directory exists\n";
452: @path = @oldpath;
453: }
454: }
455: else {
456: print "invalid path specification\n";
457: @path = @oldpath;
458: }
459: }
460: }
1.5 snw 461: } # if ..
1.2 snw 462: }
463: elsif ($cmd[0] eq "im") {
464: if($mode eq "RAS") {
465: if($user ne "---") {
466: my @msga = @cmd[1..$#cmd];
467: my $msgbody = join(' ', @msga);
468: send_im($user, $msgbody);
469: }
470: else {
1.4 snw 471: print "im: no user selected\n";
1.2 snw 472: }
473: }
474: else {
1.4 snw 475: print "im: invalid command outside of ras directory\n";
1.2 snw 476: }
477: }
478: elsif ($cmd[0] eq "trace") {
479: if($mode eq "RAS") {
480: if($user ne "---") {
481: my $id = trace_ras_sn($user);
482: $mode = "SSO";
483: $user = select_sso_user($id);
484: print_sso_user;
485: }
486: else {
1.4 snw 487: print "trace: no user select\n";
1.2 snw 488: }
489: }
490: else {
1.4 snw 491: print "trace: invalid command outside of ras directory\n";
1.2 snw 492: }
493: }
494: elsif ($cmd[0] eq "field") {
1.4 snw 495: if($mode eq "SSO") {
496: if($user ne "---") {
497: my $act = $account->{account};
498: print "$user\-\>$cmd[1]: $act->{$cmd[1]}\n";
499: }
500: else {
501: print "field: no user selected\n";
502: }
1.2 snw 503: }
504: else {
1.4 snw 505: print "field: command invalid outside of ras directory\n";
1.2 snw 506: }
507: }
1.5 snw 508: elsif ($cmd[0] eq "sessions") {
509: if($mode ne "RAS") {
510: print "sessions: must be in ras mode\n";
511: }
512: else {
1.6 snw 513: if($cmd[1]) {
514: ls "active RAS sessions", $cmd[1], list_ras_sessions();
515: }
516: else {
517: ls "active RAS sessions", '*', list_ras_sessions();
518: }
1.5 snw 519: }
520: }
521: elsif ($cmd[0] eq "lssn") {
522: if($mode ne "SSO" || $user eq "---") {
523: print "lssn: must be in sso mode with a user selected\n";
524: }
525: else {
526: my @sns = list_ras_screennames($user);
1.6 snw 527: if($cmd[1]) {
528: ls "RAS screen names for $user", $match, @sns;
529: }
530: else {
531: ls "RAS screen names for $user", '*', @sns;
532: }
1.5 snw 533: }
534: }
1.4 snw 535: elsif ($cmd[0] eq "ls") {
536: my @entries = ();
537:
538: if($mode eq "---") {
539: @entries = list_directories();
1.1 snw 540: }
541: else {
1.4 snw 542: if($user ne "---") {
543: if($mode eq "SSO") {
544: print_sso_user;
545: }
546: elsif($mode eq "RAS") {
547: print_ras_user($user);
548: }
1.2 snw 549: }
550: else {
1.4 snw 551: if($mode eq "SSO") {
552: @entries = list_sso_users();
1.2 snw 553: }
554: else {
1.4 snw 555: @entries = list_ras_users();
1.2 snw 556: }
557: }
1.4 snw 558: }
559:
560: if(@entries) {
561: my $col = 0;
562: my $pstr = join('/', @path);
563: my $pfin = "/$pstr";
1.6 snw 564: if($cmd[1]) {
565: ls $pfin, $cmd[1], @entries;
566: }
567: else {
568: ls $pfin, '*', @entries;
569: }
1.2 snw 570: }
1.4 snw 571:
1.1 snw 572: }
573: else {
1.4 snw 574: print "$cmd[0]: command not found\n";
1.1 snw 575: }
576: }
577:
578: }
579:
580: sub main {
1.4 snw 581: ($wchar, $hchar, $wpixels, $hpixels) = GetTerminalSize();
1.1 snw 582:
1.4 snw 583: GetOptions("site=s" => \$site) or die "error in command line arguments";
584:
585: if($site eq "") {
586: print "modcon: must supply -site command-line argument\n";
587: return;
588: }
1.1 snw 589:
590: $cnclient = REST::Client->new({
1.4 snw 591: host => "https://$site/rest/api",
1.1 snw 592: timeout => 10});
593:
594: print "ChivaNet MODCON $modcon_version\n";
595: print " Copyright (C) 2025 Coherent Logic Development LLC\n\n";
1.4 snw 596:
597: print "username: ";
598: $sso_account = <STDIN>;
599: chomp($sso_account);
600:
601: print "password: ";
602: ReadMode('noecho');
603: my $password = <STDIN>;
604: chomp($password);
605: ReadMode('normal');
606:
607:
608: my $params = $cnclient->buildQuery([username => $sso_account, password => $password]);
609: my $result = $cnclient->POST("/chivanet/modcon_auth", substr($params, 1), {'Content-type' => 'application/x-www-form-urlencoded'});
610: my $http_response = $result->{_res};
611: my $json = $http_response->{_content};
612: my $apiresult = decode_json($json);
1.1 snw 613:
1.4 snw 614: if($apiresult->{ok} == 1) {
615: $cnclient->addHeader('Authorization', "Apikey $apiresult->{token}");
616:
617: select_sso_user $sso_account;
618: my $act = $account->{account};
619:
620: print "\n\nWelcome to MODCON, $act->{display_name}!\n\n";
621:
622: prompt();
623: }
624: else {
625: print "\nerror: $apiresult->{error}\n";
626: return;
627: }
628:
1.1 snw 629: print "Goodbye.\n"
630: }
631:
632: main();