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