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