Annotation of loncom/LondConnection.pm, revision 1.57
1.2 albertel 1: # This module defines and implements a class that represents
2: # a connection to a lond daemon.
3: #
1.56 raeburn 4: # $Id: LondConnection.pm,v 1.55 2017/10/20 20:20:21 raeburn Exp $
1.2 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
1.1 foxr 27: #
1.14 foxr 28:
1.1 foxr 29: package LondConnection;
30:
1.10 foxr 31: use strict;
1.1 foxr 32: use IO::Socket;
33: use IO::Socket::INET;
34: use IO::Handle;
35: use IO::File;
36: use Fcntl;
37: use POSIX;
38: use Crypt::IDEA;
1.31 foxr 39: use LONCAPA::lonlocal;
40: use LONCAPA::lonssl;
1.14 foxr 41:
1.1 foxr 42:
1.32 foxr 43: my $DebugLevel=0;
1.12 foxr 44: my %perlvar;
1.54 raeburn 45: my %secureconf;
1.56 raeburn 46: my %badcerts;
1.57 ! raeburn 47: my %hosttypes;
! 48: my %crlchecked;
1.31 foxr 49: my $InsecureOk;
1.1 foxr 50:
1.14 foxr 51: #
1.16 foxr 52: # Set debugging level
53: #
54: sub SetDebug {
55: $DebugLevel = shift;
56: }
57:
58: #
1.14 foxr 59: # The config read is done in this way to support the read of
60: # the non-default configuration file in the
61: # event we are being used outside of loncapa.
62: #
63:
64: my $ConfigRead = 0;
65:
1.1 foxr 66: # Read the configuration file for apache to get the perl
1.31 foxr 67: # variables set.
1.1 foxr 68:
1.12 foxr 69: sub ReadConfig {
1.31 foxr 70: Debug(8, "ReadConfig called");
71:
1.14 foxr 72: my $perlvarref = read_conf('loncapa.conf');
1.12 foxr 73: %perlvar = %{$perlvarref};
1.17 foxr 74: $ConfigRead = 1;
1.54 raeburn 75:
1.31 foxr 76: $InsecureOk = $perlvar{loncAllowInsecure};
1.54 raeburn 77:
78: unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') {
79: Debug(1,"Failed to retrieve secureconf hash.\n");
80: }
81: unless (lonssl::Read_Host_Types(\%hosttypes,\%perlvar) eq 'ok') {
82: Debug(1,"Failed to retrieve hosttypes hash.\n");
83: }
1.57 ! raeburn 84: %badcerts = ();
! 85: %crlchecked = ();
1.54 raeburn 86: }
87:
88: sub ResetReadConfig {
89: $ConfigRead = 0;
1.15 foxr 90: }
1.1 foxr 91:
92: sub Debug {
1.30 foxr 93:
94: my ($level, $message) = @_;
95:
1.1 foxr 96: if ($level < $DebugLevel) {
1.31 foxr 97: print STDERR ($message."\n");
1.1 foxr 98: }
99: }
1.3 albertel 100:
101: =pod
102:
103: =head2 Dump
104:
1.12 foxr 105: Dump the internal state of the object: For debugging purposes, to stderr.
1.3 albertel 106:
1.1 foxr 107: =cut
108:
109: sub Dump {
110: my $self = shift;
1.32 foxr 111: my $level = shift;
1.35 foxr 112: my $now = time;
113: my $local = localtime($now);
1.32 foxr 114:
1.37 albertel 115: if ($level >= $DebugLevel) {
1.32 foxr 116: return;
117: }
118:
1.35 foxr 119:
1.10 foxr 120: my $key;
121: my $value;
1.35 foxr 122: print STDERR "[ $local ] Dumping LondConnectionObject:\n";
1.37 albertel 123: print STDERR join(':',caller(1))."\n";
1.1 foxr 124: while(($key, $value) = each %$self) {
1.22 foxr 125: print STDERR "$key -> $value\n";
1.1 foxr 126: }
1.23 foxr 127: print STDERR "-------------------------------\n";
1.1 foxr 128: }
129:
130: =pod
1.3 albertel 131:
132: Local function to do a state transition. If the state transition
133: callback is defined it is called with two parameters: the self and the
134: old state.
135:
1.1 foxr 136: =cut
1.3 albertel 137:
1.1 foxr 138: sub Transition {
1.30 foxr 139:
140: my ($self, $newstate) = @_;
141:
1.1 foxr 142: my $oldstate = $self->{State};
143: $self->{State} = $newstate;
144: $self->{TimeoutRemaining} = $self->{TimeoutValue};
145: if($self->{TransitionCallback}) {
146: ($self->{TransitionCallback})->($self, $oldstate);
147: }
148: }
149:
1.3 albertel 150:
1.14 foxr 151:
1.1 foxr 152: =pod
1.3 albertel 153:
154: =head2 new
155:
156: Construct a new lond connection.
157:
158: Parameters (besides the class name) include:
159:
160: =item hostname
161:
162: host the remote lond is on. This host is a host in the hosts.tab file
163:
164: =item port
165:
166: port number the remote lond is listening on.
167:
1.1 foxr 168: =cut
1.3 albertel 169:
1.1 foxr 170: sub new {
1.44 albertel 171: my ($class, $DnsName, $Port, $lonid) = @_;
1.14 foxr 172:
173: if (!$ConfigRead) {
174: ReadConfig();
175: $ConfigRead = 1;
176: }
1.45 albertel 177: &Debug(4,$class."::new( ".$DnsName.",".$Port.",".$lonid.")\n");
1.1 foxr 178:
1.56 raeburn 179: my ($conntype,$gotconninfo,$allowinsecure);
180: if ((ref($secureconf{'connto'}) eq 'HASH') &&
181: (exists($hosttypes{$lonid}))) {
182: $conntype = $secureconf{'connto'}{$hosttypes{$lonid}};
183: if ($conntype ne '') {
184: if ($conntype ne 'req') {
185: $allowinsecure = 1;
186: }
187: $gotconninfo = 1;
188: }
189: }
190: unless ($gotconninfo) {
191: $allowinsecure = $InsecureOk;
192: }
193:
1.1 foxr 194: # The host must map to an entry in the hosts table:
195: # We connect to the dns host that corresponds to that
196: # system and use the hostname for the encryption key
197: # negotion. In the objec these become the Host and
198: # LoncapaHim fields of the object respectively.
199: #
1.36 albertel 200: # if it is me use loopback for connection
1.44 albertel 201: if ($DnsName eq &main::my_hostname()) { $DnsName="127.0.0.1"; }
202: Debug(9, "Connecting to $DnsName");
1.1 foxr 203: # Now create the object...
204: my $self = { Host => $DnsName,
1.44 albertel 205: LoncapaHim => $lonid,
1.24 foxr 206: Port => $Port,
207: State => "Initialized",
1.31 foxr 208: AuthenticationMode => "",
1.57 ! raeburn 209: InsecureOK => $allowinsecure,
1.24 foxr 210: TransactionRequest => "",
211: TransactionReply => "",
1.39 albertel 212: NextRequest => "",
1.24 foxr 213: InformReadable => 0,
214: InformWritable => 0,
215: TimeoutCallback => undef,
216: TransitionCallback => undef,
217: Timeoutable => 0,
1.49 raeburn 218: TimeoutValue => 30,
1.24 foxr 219: TimeoutRemaining => 0,
1.31 foxr 220: LocalKeyFile => "",
1.24 foxr 221: CipherKey => "",
222: LondVersion => "Unknown",
1.52 foxr 223: Cipher => undef,
224: ClientData => undef};
1.1 foxr 225: bless($self, $class);
226: unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host},
1.27 foxr 227: PeerPort => $self->{Port},
228: Type => SOCK_STREAM,
229: Proto => "tcp",
230: Timeout => 3)) {
1.36 albertel 231: Debug(8, "Error? \n$@ \n$!");
1.1 foxr 232: return undef; # Inidicates the socket could not be made.
233: }
1.31 foxr 234: my $socket = $self->{Socket}; # For local use only.
1.51 foxr 235: $socket->sockopt(SO_KEEPALIVE, 1); # Turn on keepalive probes when idle.
1.33 foxr 236: # If we are local, we'll first try local auth mode, otherwise, we'll try
237: # the ssl auth mode:
1.31 foxr 238:
239: my $key;
240: my $keyfile;
1.36 albertel 241: if ($DnsName eq '127.0.0.1') {
1.31 foxr 242: $self->{AuthenticationMode} = "local";
243: ($key, $keyfile) = lonlocal::CreateKeyFile();
244: Debug(8, "Local key: $key, stored in $keyfile");
245:
246: # If I can't make the key file fall back to insecure if
247: # allowed...else give up right away.
248:
249: if(!(defined $key) || !(defined $keyfile)) {
1.54 raeburn 250: my $canconnect = 0;
251: if (ref($secureconf{'connto'}) eq 'HASH') {
252: unless ($secureconf{'connto'}->{'dom'} eq 'req') {
253: $canconnect = 1;
254: }
255: } else {
256: $canconnect = $InsecureOk;
257: }
258: if ($canconnect) {
1.31 foxr 259: $self->{AuthenticationMode} = "insecure";
260: $self->{TransactionRequest} = "init\n";
261: }
262: else {
263: $socket->close;
264: return undef;
265: }
266: }
267: $self->{TransactionRequest} = "init:local:$keyfile\n";
268: Debug(9, "Init string is init:local:$keyfile");
269: if(!$self->CreateCipher($key)) { # Nothing's going our way...
270: $socket->close;
271: return undef;
272: }
273:
1.42 albertel 274: } else {
1.33 foxr 275: # Remote peer: I'd like to do ssl, but if my host key or certificates
276: # are not all installed, my only choice is insecure, if that's
277: # allowed:
278:
279: my ($ca, $cert) = lonssl::CertificateFile;
280: my $sslkeyfile = lonssl::KeyFile;
1.57 ! raeburn 281: my $badcertfile = lonssl::has_badcert_file($self->{LoncapaHim});
1.33 foxr 282:
1.56 raeburn 283: if (($conntype ne 'no') && (defined($ca)) && (defined($cert)) && (defined($sslkeyfile)) &&
1.57 ! raeburn 284: (!exists($badcerts{$self->{LoncapaHim}})) && !$badcertfile) {
1.33 foxr 285: $self->{AuthenticationMode} = "ssl";
1.47 raeburn 286: $self->{TransactionRequest} = "init:ssl:$perlvar{'lonVersion'}\n";
1.56 raeburn 287: } elsif ($self->{InsecureOK}) {
1.54 raeburn 288: # Allowed to do insecure:
289: $self->{AuthenticationMode} = "insecure";
290: $self->{TransactionRequest} = "init::$perlvar{'lonVersion'}\n";
1.33 foxr 291: } else {
1.54 raeburn 292: # Not allowed to do insecure...
293: $socket->close;
294: return undef;
1.33 foxr 295: }
1.31 foxr 296: }
297:
1.1 foxr 298: #
299: # We're connected. Set the state, and the events we'll accept:
300: #
301: $self->Transition("Connected");
302: $self->{InformWritable} = 1; # When socket is writable we send init
1.9 foxr 303: $self->{Timeoutable} = 1; # Timeout allowed during startup negotiation.
1.31 foxr 304:
1.1 foxr 305:
306: #
307: # Set socket to nonblocking I/O.
308: #
1.31 foxr 309: my $flags = fcntl($socket, F_GETFL,0);
310: if(!$flags) {
1.1 foxr 311: $socket->close;
312: return undef;
313: }
1.31 foxr 314: if(!fcntl($socket, F_SETFL, $flags | O_NONBLOCK)) {
1.1 foxr 315: $socket->close;
316: return undef;
317: }
318:
319: # return the object :
320:
1.31 foxr 321: Debug(9, "Initial object state: ");
1.32 foxr 322: $self->Dump(9);
1.31 foxr 323:
1.1 foxr 324: return $self;
325: }
1.3 albertel 326:
1.1 foxr 327: =pod
1.3 albertel 328:
329: =head2 Readable
330:
331: This member should be called when the Socket becomes readable. Until
332: the read completes, action is state independet. Data are accepted into
333: the TransactionReply until a newline character is received. At that
334: time actionis state dependent:
335:
336: =item Connected
337:
338: in this case we received challenge, the state changes to
339: ChallengeReceived, and we initiate a send with the challenge response.
340:
341: =item ReceivingReply
342:
343: In this case a reply has been received for a transaction, the state
344: goes to Idle and we disable write and read notification.
345:
346: =item ChallengeReeived
347:
348: we just got what should be an ok\n and the connection can now handle
349: transactions.
1.1 foxr 350:
351: =cut
1.3 albertel 352:
1.1 foxr 353: sub Readable {
354: my $self = shift;
355: my $socket = $self->{Socket};
356: my $data = '';
1.27 foxr 357: my $rv;
1.31 foxr 358: my $ConnectionMode = $self->{AuthenticationMode};
359:
1.27 foxr 360: if ($socket) {
361: eval {
362: $rv = $socket->recv($data, POSIX::BUFSIZ, 0);
363: }
364: } else {
365: $self->Transition("Disconnected");
366: return -1;
367: }
1.1 foxr 368: my $errno = $! + 0; # Force numeric context.
369:
1.8 foxr 370: unless (defined($rv) && length $data) {# Read failed,
1.1 foxr 371: if(($errno == POSIX::EWOULDBLOCK) ||
372: ($errno == POSIX::EAGAIN) ||
1.8 foxr 373: ($errno == POSIX::EINTR)) {
1.1 foxr 374: return 0;
375: }
376:
377: # Connection likely lost.
378: &Debug(4, "Connection lost");
379: $self->{TransactionRequest} = '';
380: $socket->close();
381: $self->Transition("Disconnected");
382: return -1;
383: }
1.53 foxr 384: # If we actually got data, reset the timeout.
385:
386: if (length $data) {
387: $self->{TimeoutRemaining} = $self->{TimeoutValue}; # getting data resets the timeout period.
388: }
1.1 foxr 389: # Append the data to the buffer. And figure out if the read is done:
390:
391: &Debug(9,"Received from host: ".$data);
392: $self->{TransactionReply} .= $data;
1.29 albertel 393: if($self->{TransactionReply} =~ m/\n$/) {
1.1 foxr 394: &Debug(8,"Readable End of line detected");
1.31 foxr 395:
396:
1.1 foxr 397: if ($self->{State} eq "Initialized") { # We received the challenge:
1.31 foxr 398: # Our init was replied to. What happens next depends both on
399: # the actual init we sent (AuthenticationMode member data)
400: # and the response:
401: # AuthenticationMode == local:
402: # Response ok: The key has been exchanged and
403: # the key file destroyed. We can jump
404: # into setting the host and requesting the
405: # Later we'll also bypass key exchange.
406: # Response digits:
407: # Old style lond. Delete the keyfile.
408: # If allowed fall back to insecure mode.
409: # else close connection and fail.
410: # Response other:
411: # Failed local auth
412: # Close connection and fail.
413: #
414: # AuthenticationMode == ssl:
415: # Response ok:ssl
416: # Response digits:
417: # Response other:
418: # Authentication mode == insecure
419: # Response digits
420: # Response other:
421:
422: my $Response = $self->{TransactionReply};
423: if($ConnectionMode eq "local") {
424: if($Response =~ /^ok:local/) { # Good local auth.
425: $self->ToVersionRequest();
426: return 0;
427: }
428: elsif ($Response =~/^[0-9]+/) { # Old style lond.
429: return $self->CompleteInsecure();
430:
431: }
432: else { # Complete flop
433: &Debug(3, "init:local : unrecognized reply");
434: $self->Transition("Disconnected");
435: $socket->close;
436: return -1;
437: }
438: }
439: elsif ($ConnectionMode eq "ssl") {
440: if($Response =~ /^ok:ssl/) { # Good ssl...
1.56 raeburn 441: my $sslresult = $self->ExchangeKeysViaSSL();
442: if ($sslresult == 1) { # Success skip to vsn stuff
1.31 foxr 443: # Need to reset to non blocking:
444:
445: my $flags = fcntl($socket, F_GETFL, 0);
446: fcntl($socket, F_SETFL, $flags | O_NONBLOCK);
447: $self->ToVersionRequest();
448: return 0;
1.57 ! raeburn 449: }
! 450: else { # Failed in ssl exchange.
! 451: if (($sslresult == -1) && (lonssl::LastError == -1) && ($self->{InsecureOK})) {
! 452: my $badcertdir = &lonssl::BadCertDir();
! 453: if (($badcertdir) && $self->{LoncapaHim}) {
! 454: if (open(my $fh,'>',"$badcertdir/".$self->{LoncapaHim})) {
! 455: close($fh);
! 456: }
! 457: }
1.56 raeburn 458: $badcerts{$self->{LoncapaHim}} = 1;
1.57 ! raeburn 459: &Debug(3,"SSL verification failed: close socket and initiate insecure connection");
! 460: $self->Transition("ReInitNoSSL");
! 461: $socket->close;
! 462: return -1;
1.56 raeburn 463: }
1.31 foxr 464: &Debug(3,"init:ssl failed key negotiation!");
465: $self->Transition("Disconnected");
466: $socket->close;
467: return -1;
1.57 ! raeburn 468: }
1.31 foxr 469: }
470: elsif ($Response =~ /^[0-9]+/) { # Old style lond.
471: return $self->CompleteInsecure();
472: }
473: else { # Complete flop
474: }
475: }
476: elsif ($ConnectionMode eq "insecure") {
477: if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have
478:
479: $self->Transition("Disconnected"); # in host tables.
480: $socket->close();
481: return -1;
482:
483: }
484: return $self->CompleteInsecure();
485: }
486: else {
487: &Debug(1,"Authentication mode incorrect");
488: die "BUG!!! LondConnection::Readable invalid authmode";
1.1 foxr 489: }
1.27 foxr 490:
1.31 foxr 491:
1.28 albertel 492: } elsif ($self->{State} eq "ChallengeReplied") {
493: if($self->{TransactionReply} ne "ok\n") {
494: $self->Transition("Disconnected");
495: $socket->close();
496: return -1;
497: }
1.31 foxr 498: $self->ToVersionRequest();
1.28 albertel 499: return 0;
1.31 foxr 500:
1.28 albertel 501: } elsif ($self->{State} eq "ReadingVersionString") {
1.38 albertel 502: chomp($self->{TransactionReply});
503: $self->{LondVersion} = $self->{TransactionReply};
1.28 albertel 504: $self->Transition("SetHost");
505: $self->{InformReadable} = 0;
506: $self->{InformWritable} = 1;
507: my $peer = $self->{LoncapaHim};
508: $self->{TransactionRequest}= "sethost:$peer\n";
509: return 0;
1.24 foxr 510: } elsif ($self->{State} eq "HostSet") { # should be ok.
1.28 albertel 511: if($self->{TransactionReply} ne "ok\n") {
512: $self->Transition("Disconnected");
513: $socket->close();
514: return -1;
515: }
1.31 foxr 516: # If the auth mode is insecure we must still
517: # exchange session keys. Otherwise,
518: # we can just transition to idle.
519:
520: if($ConnectionMode eq "insecure") {
521: $self->Transition("RequestingKey");
522: $self->{InformReadable} = 0;
523: $self->{InformWritable} = 1;
524: $self->{TransactionRequest} = "ekey\n";
525: return 0;
526: }
527: else {
528: $self->ToIdle();
529: return 0;
530: }
1.1 foxr 531: } elsif ($self->{State} eq "ReceivingKey") {
532: my $buildkey = $self->{TransactionReply};
533: my $key = $self->{LoncapaHim}.$perlvar{'lonHostID'};
534: $key=~tr/a-z/A-Z/;
535: $key=~tr/G-P/0-9/;
536: $key=~tr/Q-Z/0-9/;
1.31 foxr 537: $key =$key.$buildkey.$key.$buildkey.$key.$buildkey;
538: $key = substr($key,0,32);
539: if(!$self->CreateCipher($key)) {
1.1 foxr 540: $self->Transition("Disconnected");
541: $socket->close();
542: return -1;
543: } else {
1.31 foxr 544: $self->ToIdle();
1.1 foxr 545: return 0;
546: }
547: } elsif ($self->{State} eq "ReceivingReply") {
548:
549: # If the data are encrypted, decrypt first.
550:
551: my $answer = $self->{TransactionReply};
552: if($answer =~ /^enc\:/) {
553: $answer = $self->Decrypt($answer);
1.34 foxr 554: $self->{TransactionReply} = "$answer\n";
1.1 foxr 555: }
1.39 albertel 556: # if we have a NextRequest do it immeadiately
557: if ($self->{NextRequest}) {
558: $self->{TransactionRequest} = $self->{NextRequest};
559: undef( $self->{NextRequest} );
560: $self->{TransactionReply} = "";
561: $self->{InformWritable} = 1;
562: $self->{InformReadable} = 0;
563: $self->{Timeoutable} = 1;
564: $self->Transition("SendingRequest");
565: return 0;
566: } else {
1.1 foxr 567: # finish the transaction
568:
1.39 albertel 569: $self->ToIdle();
570: return 0;
571: }
1.1 foxr 572: } elsif ($self->{State} eq "Disconnected") { # No connection.
573: return -1;
574: } else { # Internal error: Invalid state.
575: $self->Transition("Disconnected");
576: $socket->close();
577: return -1;
578: }
579: }
580:
581: return 0;
1.27 foxr 582:
1.1 foxr 583: }
584:
585:
586: =pod
1.3 albertel 587:
588: This member should be called when the Socket becomes writable.
589:
590: The action is state independent. An attempt is made to drain the
591: contents of the TransactionRequest member. Once this is drained, we
592: mark the object as waiting for readability.
1.1 foxr 593:
594: Returns 0 if successful, or -1 if not.
1.3 albertel 595:
1.1 foxr 596: =cut
597: sub Writable {
598: my $self = shift; # Get reference to the object.
599: my $socket = $self->{Socket};
1.26 albertel 600: my $nwritten;
601: if ($socket) {
602: eval {
603: $nwritten = $socket->send($self->{TransactionRequest}, 0);
604: }
1.27 foxr 605: } else {
606: # For whatever reason, there's no longer a socket left.
607:
608:
609: $self->Transition("Disconnected");
610: return -1;
1.26 albertel 611: }
1.1 foxr 612: my $errno = $! + 0;
613: unless (defined $nwritten) {
614: if($errno != POSIX::EINTR) {
615: $self->Transition("Disconnected");
616: return -1;
617: }
618:
619: }
1.10 foxr 620: if (($nwritten >= 0) ||
1.1 foxr 621: ($errno == POSIX::EWOULDBLOCK) ||
622: ($errno == POSIX::EAGAIN) ||
623: ($errno == POSIX::EINTR) ||
624: ($errno == 0)) {
1.50 foxr 625: $self->{TimeoutRemaining} = $self->{TimeoutValue};
1.1 foxr 626: substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part
1.50 foxr 627: if(length $self->{TransactionRequest} == 0) {
628: $self->{InformWritable} = 0;
629: $self->{InformReadable} = 1;
630: $self->{TransactionReply} = '';
631: #
632: # Figure out the next state:
633: #
634: if($self->{State} eq "Connected") {
635: $self->Transition("Initialized");
636: } elsif($self->{State} eq "ChallengeReceived") {
637: $self->Transition("ChallengeReplied");
638: } elsif($self->{State} eq "RequestingVersion") {
639: $self->Transition("ReadingVersionString");
640: } elsif ($self->{State} eq "SetHost") {
641: $self->Transition("HostSet");
642: } elsif($self->{State} eq "RequestingKey") {
643: $self->Transition("ReceivingKey");
1.24 foxr 644: # $self->{InformWritable} = 0;
645: # $self->{InformReadable} = 1;
646: # $self->{TransactionReply} = '';
1.50 foxr 647: } elsif ($self->{State} eq "SendingRequest") {
648: $self->Transition("ReceivingReply");
649: $self->{TimeoutRemaining} = $self->{TimeoutValue};
650: } elsif ($self->{State} eq "Disconnected") {
651: return -1;
652: }
653: return 0;
654: }
655: } else { # The write failed (e.g. partner disconnected).
656: $self->Transition("Disconnected");
657: $socket->close();
658: return -1;
659: }
660:
1.1 foxr 661: }
662: =pod
1.3 albertel 663:
664: =head2 Tick
665:
1.1 foxr 666: Tick is called every time unit by the event framework. It
1.3 albertel 667:
668: =item 1 decrements the remaining timeout.
669:
670: =item 2 If the timeout is zero, calls TimedOut indicating that the current operation timed out.
1.1 foxr 671:
672: =cut
673:
674: sub Tick {
675: my $self = shift;
676: $self->{TimeoutRemaining}--;
677: if ($self->{TimeoutRemaining} < 0) {
678: $self->TimedOut();
679: }
680: }
1.3 albertel 681:
1.1 foxr 682: =pod
683:
1.3 albertel 684: =head2 TimedOut
685:
686: called on a timeout. If the timeout callback is defined, it is called
687: with $self as its parameters.
688:
689: =cut
690:
1.1 foxr 691: sub TimedOut {
692:
693: my $self = shift;
694: if($self->{TimeoutCallback}) {
695: my $callback = $self->{TimeoutCallback};
696: my @args = ( $self);
697: &$callback(@args);
698: }
699: }
1.3 albertel 700:
1.1 foxr 701: =pod
1.3 albertel 702:
703: =head2 InitiateTransaction
704:
705: Called to initiate a transaction. A transaction can only be initiated
706: when the object is idle... otherwise an error is returned. A
707: transaction consists of a request to the server that will have a
708: reply. This member sets the request data in the TransactionRequest
709: member, makes the state SendingRequest and sets the data to allow a
710: timout, and to request writability notification.
711:
1.1 foxr 712: =cut
1.3 albertel 713:
1.1 foxr 714: sub InitiateTransaction {
1.30 foxr 715:
716: my ($self, $data) = @_;
1.1 foxr 717:
1.4 foxr 718: Debug(1, "initiating transaction: ".$data);
1.1 foxr 719: if($self->{State} ne "Idle") {
1.4 foxr 720: Debug(0," .. but not idle here\n");
1.1 foxr 721: return -1; # Error indicator.
722: }
723: # if the transaction is to be encrypted encrypt the data:
1.39 albertel 724: (my $sethost, my $server,$data)=split(/:/,$data,3);
1.1 foxr 725:
726: if($data =~ /^encrypt\:/) {
727: $data = $self->Encrypt($data);
728: }
729:
730: # Setup the trasaction
1.39 albertel 731: # currently no version of lond supports inlining the sethost
1.40 albertel 732: if ($self->PeerVersion() <= 321) {
1.39 albertel 733: if ($server ne $self->{LoncapaHim}) {
734: $self->{NextRequest} = $data;
735: $self->{TransactionRequest} = "$sethost:$server\n";
736: $self->{LoncapaHim} = $server;
737: } else {
738: $self->{TransactionRequest} = $data;
739: }
740: } else {
1.40 albertel 741: $self->{LoncapaHim} = $server;
1.39 albertel 742: $self->{TransactionRequest} = "$sethost:$server:$data";
743: }
1.1 foxr 744: $self->{TransactionReply} = "";
745: $self->{InformWritable} = 1;
746: $self->{InformReadable} = 0;
747: $self->{Timeoutable} = 1;
748: $self->{TimeoutRemaining} = $self->{TimeoutValue};
749: $self->Transition("SendingRequest");
750: }
751:
752:
753: =pod
1.3 albertel 754:
755: =head2 SetStateTransitionCallback
756:
757: Sets a callback for state transitions. Returns a reference to any
758: prior established callback, or undef if there was none:
759:
1.1 foxr 760: =cut
1.3 albertel 761:
1.1 foxr 762: sub SetStateTransitionCallback {
763: my $self = shift;
764: my $oldCallback = $self->{TransitionCallback};
765: $self->{TransitionCallback} = shift;
766: return $oldCallback;
767: }
1.3 albertel 768:
1.1 foxr 769: =pod
1.3 albertel 770:
771: =head2 SetTimeoutCallback
772:
773: Sets the timeout callback. Returns a reference to any prior
774: established callback or undef if there was none.
775:
1.1 foxr 776: =cut
1.3 albertel 777:
1.1 foxr 778: sub SetTimeoutCallback {
1.30 foxr 779:
780: my ($self, $callback) = @_;
781:
1.1 foxr 782: my $oldCallback = $self->{TimeoutCallback};
783: $self->{TimeoutCallback} = $callback;
784: return $oldCallback;
785: }
786:
787: =pod
1.3 albertel 788:
1.5 foxr 789: =head2 Shutdown:
790:
791: Shuts down the socket.
792:
793: =cut
794:
795: sub Shutdown {
796: my $self = shift;
797: my $socket = $self->GetSocket();
1.20 albertel 798: Debug(5,"socket is -$socket-");
799: if ($socket) {
800: # Ask lond to exit too. Non blocking so
801: # there is no cost for failure.
802: eval {
803: $socket->send("exit\n", 0);
804: $socket->shutdown(2);
805: }
806: }
1.50 foxr 807: $self->{Timeoutable} = 0; # Shutdown sockets can't timeout.
1.5 foxr 808: }
809:
810: =pod
811:
1.3 albertel 812: =head2 GetState
813:
814: selector for the object state.
815:
1.1 foxr 816: =cut
1.3 albertel 817:
1.1 foxr 818: sub GetState {
819: my $self = shift;
820: return $self->{State};
821: }
1.3 albertel 822:
1.1 foxr 823: =pod
1.3 albertel 824:
825: =head2 GetSocket
826:
827: selector for the object socket.
828:
1.1 foxr 829: =cut
1.3 albertel 830:
1.1 foxr 831: sub GetSocket {
832: my $self = shift;
833: return $self->{Socket};
834: }
1.3 albertel 835:
1.5 foxr 836:
1.1 foxr 837: =pod
1.3 albertel 838:
839: =head2 WantReadable
840:
841: Return the state of the flag that indicates the object wants to be
842: called when readable.
843:
1.1 foxr 844: =cut
1.3 albertel 845:
1.1 foxr 846: sub WantReadable {
847: my $self = shift;
848:
849: return $self->{InformReadable};
850: }
1.3 albertel 851:
1.1 foxr 852: =pod
1.3 albertel 853:
854: =head2 WantWritable
855:
856: Return the state of the flag that indicates the object wants write
857: notification.
858:
1.1 foxr 859: =cut
1.3 albertel 860:
1.1 foxr 861: sub WantWritable {
862: my $self = shift;
863: return $self->{InformWritable};
864: }
1.3 albertel 865:
1.1 foxr 866: =pod
1.3 albertel 867:
868: =head2 WantTimeout
869:
870: return the state of the flag that indicates the object wants to be
871: informed of timeouts.
872:
1.1 foxr 873: =cut
1.3 albertel 874:
1.1 foxr 875: sub WantTimeout {
876: my $self = shift;
877: return $self->{Timeoutable};
878: }
879:
880: =pod
1.3 albertel 881:
882: =head2 GetReply
883:
884: Returns the reply from the last transaction.
885:
1.1 foxr 886: =cut
1.3 albertel 887:
1.1 foxr 888: sub GetReply {
889: my $self = shift;
890: return $self->{TransactionReply};
891: }
892:
893: =pod
1.3 albertel 894:
895: =head2 Encrypt
896:
897: Returns the encrypted version of the command string.
898:
899: The command input string is of the form:
900:
1.1 foxr 901: encrypt:command
1.3 albertel 902:
903: The output string can be directly sent to lond as it is of the form:
904:
1.1 foxr 905: enc:length:<encodedrequest>
1.3 albertel 906:
1.1 foxr 907: =cut
1.3 albertel 908:
1.1 foxr 909: sub Encrypt {
1.30 foxr 910:
911: my ($self, $request) = @_;
1.1 foxr 912:
913:
914: # Split the encrypt: off the request and figure out it's length.
915: # the cipher works in blocks of 8 bytes.
916:
917: my $cmd = $request;
918: $cmd =~ s/^encrypt\://; # strip off encrypt:
919: chomp($cmd); # strip off trailing \n
920: my $length=length($cmd); # Get the string length.
921: $cmd .= " "; # Pad with blanks so we can fill out a block.
922:
923: # encrypt the request in 8 byte chunks to create the encrypted
924: # output request.
925:
926: my $Encoded = '';
927: for(my $index = 0; $index <= $length; $index += 8) {
928: $Encoded .=
929: unpack("H16",
930: $self->{Cipher}->encrypt(substr($cmd,
931: $index, 8)));
932: }
933:
934: # Build up the answer as enc:length:$encrequest.
935:
936: $request = "enc:$length:$Encoded\n";
937: return $request;
938:
939:
940: }
1.3 albertel 941:
942: =pod
943:
944: =head2 Decrypt
945:
946: Decrypt a response from the server. The response is in the form:
947:
948: enc:<length>:<encrypted data>
949:
1.1 foxr 950: =cut
1.3 albertel 951:
1.1 foxr 952: sub Decrypt {
1.30 foxr 953:
954: my ($self, $encrypted) = @_;
1.1 foxr 955:
956: # Bust up the response into length, and encryptedstring:
957:
958: my ($enc, $length, $EncryptedString) = split(/:/,$encrypted);
959: chomp($EncryptedString);
960:
961: # Decode the data in 8 byte blocks. The string is encoded
962: # as hex digits so there are two characters per byte:
963:
1.10 foxr 964: my $decrypted = "";
1.1 foxr 965: for(my $index = 0; $index < length($EncryptedString);
966: $index += 16) {
967: $decrypted .= $self->{Cipher}->decrypt(
968: pack("H16",
969: substr($EncryptedString,
970: $index,
971: 16)));
972: }
973: # the answer may have trailing pads to fill out a block.
974: # $length tells us the actual length of the decrypted string:
975:
976: $decrypted = substr($decrypted, 0, $length);
1.34 foxr 977: Debug(9, "Decrypted $EncryptedString to $decrypted");
1.1 foxr 978:
979: return $decrypted;
980:
981: }
1.31 foxr 982: # ToIdle
983: # Called to transition to idle... done enough it's worth subbing
984: # off to ensure it's always done right!!
985: #
986: sub ToIdle {
987: my $self = shift;
988:
989: $self->Transition("Idle");
990: $self->{InformWritiable} = 0;
991: $self->{InformReadable} = 0;
992: $self->{Timeoutable} = 0;
993: }
994:
995: # ToVersionRequest
996: # Called to transition to "RequestVersion" also done a few times
997: # so worth subbing out.
998: #
999: sub ToVersionRequest {
1000: my $self = shift;
1001:
1002: $self->Transition("RequestingVersion");
1003: $self->{InformReadable} = 0;
1004: $self->{InformWritable} = 1;
1005: $self->{TransactionRequest} = "version\n";
1006:
1007: }
1008: #
1009: # CreateCipher
1010: # Given a cipher key stores the key in the object context,
1011: # creates the cipher object, (stores that in object context),
1012: # This is done a couple of places, so it's worth factoring it out.
1013: #
1014: # Parameters:
1015: # (self)
1016: # key - The Cipher key.
1017: #
1018: # Returns:
1019: # 0 - Failure to create IDEA cipher.
1020: # 1 - Success.
1021: #
1022: sub CreateCipher {
1023: my ($self, $key) = @_; # According to coding std.
1024:
1025: $self->{CipherKey} = $key; # Save the text key...
1026: my $packedkey = pack ("H32", $key);
1027: my $cipher = new IDEA $packedkey;
1028: if($cipher) {
1029: $self->{Cipher} = $cipher;
1030: Debug("Cipher created dumping socket: ");
1.32 foxr 1031: $self->Dump(9);
1.31 foxr 1032: return 1;
1033: }
1034: else {
1035: return 0;
1036: }
1037: }
1038: # ExchangeKeysViaSSL
1039: # Called to do cipher key exchange via SSL.
1040: # The socket is promoted to an SSL socket. If that's successful,
1041: # we read out cipher key through the socket and create an IDEA
1042: # cipher object.
1043: # Parameters:
1044: # (self)
1045: # Returns:
1046: # true - Success.
1047: # false - Failure.
1048: #
1049: # Assumptions:
1050: # 1. The ssl session setup has timeout logic built in so we don't
1051: # have to worry about DOS attacks at that stage.
1052: # 2. If the ssl session gets set up we are talking to a legitimate
1053: # lond so again we don't have to worry about DOS attacks.
1054: # All this allows us just to call
1055: sub ExchangeKeysViaSSL {
1056: my $self = shift;
1057: my $socket = $self->{Socket};
1.56 raeburn 1058: my $peer = $self->{LoncapaHim};
1.31 foxr 1059:
1060: # Get our signed certificate, the certificate authority's
1061: # certificate and our private key file. All of these
1062: # are needed to create the ssl connection.
1063:
1064: my ($SSLCACertificate,
1065: $SSLCertificate) = lonssl::CertificateFile();
1066: my $SSLKey = lonssl::KeyFile();
1.57 ! raeburn 1067: my $CRLFile;
! 1068: unless ($crlchecked{$peer}) {
! 1069: $CRLFile = lonssl::CRLFile();
! 1070: $crlchecked{$peer} = 1;
! 1071: }
1.31 foxr 1072: # Promote our connection to ssl and read the key from lond.
1073:
1074: my $SSLSocket = lonssl::PromoteClientSocket($socket,
1075: $SSLCACertificate,
1076: $SSLCertificate,
1.56 raeburn 1077: $SSLKey,
1.57 ! raeburn 1078: $peer,
! 1079: $CRLFile);
1.31 foxr 1080: if(defined $SSLSocket) {
1081: my $key = <$SSLSocket>;
1082: lonssl::Close($SSLSocket);
1083: if($key) {
1084: chomp($key); # \n is not part of the key.
1085: return $self->CreateCipher($key);
1086: }
1087: else {
1088: Debug(3, "Failed to read ssl key");
1089: return 0;
1090: }
1091: }
1092: else {
1093: # Failed!!
1094: Debug(3, "Failed to negotiate SSL connection!");
1.56 raeburn 1095: return -1;
1.31 foxr 1096: }
1097: # should not get here
1098: return 0;
1099:
1100: }
1101:
1102:
1103:
1104: #
1105: # CompleteInsecure:
1106: # This function is called to initiate the completion of
1107: # insecure challenge response negotiation.
1108: # To do this, we copy the challenge string to the transaction
1109: # request, flip to writability and state transition to
1110: # ChallengeReceived..
1111: # All this is only possible if InsecureOk is true.
1112: # Parameters:
1113: # (self) - This object's context hash.
1114: # Return:
1115: # 0 - Ok to transition.
1116: # -1 - Not ok to transition (InsecureOk not ok).
1117: #
1118: sub CompleteInsecure {
1119: my $self = shift;
1.56 raeburn 1120: if ($self->{InsecureOK}) {
1.31 foxr 1121: $self->{AuthenticationMode} = "insecure";
1122: &Debug(8," Transition out of Initialized:insecure");
1123: $self->{TransactionRequest} = $self->{TransactionReply};
1124: $self->{InformWritable} = 1;
1125: $self->{InformReadable} = 0;
1126: $self->Transition("ChallengeReceived");
1127: $self->{TimeoutRemaining} = $self->{TimeoutValue};
1128: return 0;
1129:
1130:
1131: }
1132: else {
1133: &Debug(3, "Insecure key negotiation disabled!");
1134: my $socket = $self->{Socket};
1135: $socket->close;
1136: return -1;
1137: }
1138: }
1.1 foxr 1139:
1.14 foxr 1140: ###########################################################
1141: #
1142: # The following is an unashamed kludge that is here to
1143: # allow LondConnection to be used outside of the
1144: # loncapa environment (e.g. by lonManage).
1145: #
1146: # This is a textual inclusion of pieces of the
1147: # Configuration.pm module.
1148: #
1149:
1150:
1.43 raeburn 1151: my @confdirs=('/etc/httpd/conf/','/etc/apache2/');
1.14 foxr 1152:
1153: # ------------------- Subroutine read_conf: read LON-CAPA server configuration.
1154: # This subroutine reads PerlSetVar values out of specified web server
1155: # configuration files.
1156: sub read_conf
1157: {
1158: my (@conf_files)=@_;
1.43 raeburn 1159: my (%perlvar,%configdirs);
1160: foreach my $filename (@conf_files,'loncapa_apache.conf') {
1161: my $configdir = '';
1162: $configdirs{$filename} = [@confdirs];
1163: while ($configdir eq '' && @{$configdirs{$filename}} > 0) {
1164: my $testdir = shift(@{$configdirs{$filename}});
1165: if (-e $testdir.$filename) {
1166: $configdir = $testdir;
1167: }
1168: }
1169: if ($configdir eq '') {
1170: die("Couldn't find a directory containing $filename");
1171: }
1172: if($DebugLevel > 3) {
1173: print STDERR ("Going to read $configdir.$filename\n");
1174: }
1175: open(CONFIG,'<'.$configdir.$filename) or
1176: die("Can't read $configdir$filename");
1177: while (my $configline=<CONFIG>) {
1178: if ($configline =~ /^[^\#]*PerlSetVar/) {
1179: my ($unused,$varname,$varvalue)=split(/\s+/,$configline);
1.14 foxr 1180: chomp($varvalue);
1181: $perlvar{$varname}=$varvalue;
1.43 raeburn 1182: }
1183: }
1.14 foxr 1184: close(CONFIG);
1.43 raeburn 1185: }
1.21 foxr 1186: if($DebugLevel > 3) {
1.31 foxr 1187: print STDERR "Dumping perlvar:\n";
1.21 foxr 1188: foreach my $var (keys %perlvar) {
1.31 foxr 1189: print STDERR "$var = $perlvar{$var}\n";
1.21 foxr 1190: }
1191: }
1.14 foxr 1192: my $perlvarref=\%perlvar;
1.21 foxr 1193: return $perlvarref;
1194: }
1.14 foxr 1195:
1.24 foxr 1196: #
1197: # Get the version of our peer. Note that this is only well
1198: # defined if the state machine has hit the idle state at least
1199: # once (well actually if it has transitioned out of
1200: # ReadingVersionString The member data LondVersion is returned.
1201: #
1202: sub PeerVersion {
1203: my $self = shift;
1.40 albertel 1204: my ($version) = ($self->{LondVersion} =~ /Revision: 1\.(\d+)/);
1205: return $version;
1.24 foxr 1206: }
1.1 foxr 1207:
1.52 foxr 1208: #
1209: # Manipulate the client data field
1210: #
1211: sub SetClientData {
1212: my ($self, $newData) = @_;
1213: $self->{ClientData} = $newData;
1214: }
1215: #
1216: # Get the current client data field.
1217: #
1218: sub GetClientData {
1219: my $self = shift;
1220: return $self->{ClientData};
1221: }
1222:
1.55 raeburn 1223: #
1224: # Get the HostID of our peer
1225: #
1226:
1227: sub PeerLoncapaHim {
1228: my $self = shift;
1229: return $self->{LoncapaHim};
1230: }
1231:
1.57 ! raeburn 1232: #
! 1233: # Get the Authentication mode
! 1234: #
! 1235:
! 1236: sub GetKeyMode {
! 1237: my $self = shift;
! 1238: return $self->{AuthenticationMode};
! 1239: }
! 1240:
1.1 foxr 1241: 1;
1242:
1243: =pod
1.3 albertel 1244:
1.1 foxr 1245: =head1 Theory
1246:
1.3 albertel 1247: The lond object is a state machine. It lives through the following states:
1248:
1249: =item Connected:
1250:
1251: a TCP connection has been formed, but the passkey has not yet been
1252: negotiated.
1253:
1254: =item Initialized:
1255:
1256: "init" sent.
1257:
1258: =item ChallengeReceived:
1259:
1260: lond sent its challenge to us.
1261:
1262: =item ChallengeReplied:
1263:
1264: We replied to lond's challenge waiting for lond's ok.
1265:
1266: =item RequestingKey:
1267:
1268: We are requesting an encryption key.
1269:
1270: =item ReceivingKey:
1271:
1272: We are receiving an encryption key.
1273:
1274: =item Idle:
1275:
1276: Connection was negotiated but no requests are active.
1277:
1278: =item SendingRequest:
1279:
1280: A request is being sent to the peer.
1281:
1282: =item ReceivingReply:
1283:
1284: Waiting for an entire reply from the peer.
1285:
1286: =item Disconnected:
1287:
1288: For whatever reason, the connection was dropped.
1289:
1290: When we need to be writing data, we have a writable event. When we
1291: need to be reading data, a readable event established. Events
1292: dispatch through the class functions Readable and Writable, and the
1293: watcher contains a reference to the associated object to allow object
1294: context to be reached.
1.1 foxr 1295:
1296: =head2 Member data.
1297:
1.3 albertel 1298: =item Host
1299:
1300: Host socket is connected to.
1301:
1302: =item Port
1303:
1304: The port the remote lond is listening on.
1305:
1306: =item Socket
1307:
1308: Socket open on the connection.
1309:
1310: =item State
1311:
1312: The current state.
1313:
1.31 foxr 1314: =item AuthenticationMode
1315:
1316: How authentication is being done. This can be any of:
1317:
1318: o local - Authenticate via a key exchanged in a file.
1319: o ssl - Authenticate via a key exchaned through a temporary ssl tunnel.
1320: o insecure - Exchange keys in an insecure manner.
1321:
1322: insecure is only allowed if the configuration parameter loncAllowInsecure
1323: is nonzero.
1324:
1.3 albertel 1325: =item TransactionRequest
1326:
1327: The request being transmitted.
1328:
1329: =item TransactionReply
1330:
1331: The reply being received from the transaction.
1332:
1333: =item InformReadable
1334:
1335: True if we want to be called when socket is readable.
1336:
1337: =item InformWritable
1338:
1339: True if we want to be informed if the socket is writable.
1340:
1341: =item Timeoutable
1342:
1343: True if the current operation is allowed to timeout.
1344:
1345: =item TimeoutValue
1346:
1347: Number of seconds in the timeout.
1348:
1349: =item TimeoutRemaining
1350:
1351: Number of seconds left in the timeout.
1352:
1353: =item CipherKey
1354:
1355: The key that was negotiated with the peer.
1356:
1357: =item Cipher
1358:
1359: The cipher obtained via the key.
1.1 foxr 1360:
1361:
1362: =head2 The following are callback like members:
1.3 albertel 1363:
1364: =item Tick:
1365:
1366: Called in response to a timer tick. Used to managed timeouts etc.
1367:
1368: =item Readable:
1369:
1370: Called when the socket becomes readable.
1371:
1372: =item Writable:
1373:
1374: Called when the socket becomes writable.
1375:
1376: =item TimedOut:
1377:
1378: Called when a timed operation timed out.
1379:
1.1 foxr 1380:
1381: =head2 The following are operational member functions.
1.3 albertel 1382:
1383: =item InitiateTransaction:
1384:
1385: Called to initiate a new transaction
1386:
1387: =item SetStateTransitionCallback:
1388:
1389: Called to establish a function that is called whenever the object goes
1390: through a state transition. This is used by The client to manage the
1391: work flow for the object.
1392:
1393: =item SetTimeoutCallback:
1394:
1395: Set a function to be called when a transaction times out. The
1396: function will be called with the object as its sole parameter.
1397:
1398: =item Encrypt:
1399:
1400: Encrypts a block of text according to the cipher negotiated with the
1401: peer (assumes the text is a command).
1402:
1403: =item Decrypt:
1404:
1405: Decrypts a block of text according to the cipher negotiated with the
1406: peer (assumes the block was a reply.
1.5 foxr 1407:
1408: =item Shutdown:
1409:
1410: Shuts off the socket.
1.1 foxr 1411:
1412: =head2 The following are selector member functions:
1413:
1.3 albertel 1414: =item GetState:
1415:
1416: Returns the current state
1417:
1418: =item GetSocket:
1419:
1420: Gets the socekt open on the connection to lond.
1421:
1422: =item WantReadable:
1423:
1424: true if the current state requires a readable event.
1425:
1426: =item WantWritable:
1427:
1428: true if the current state requires a writable event.
1429:
1430: =item WantTimeout:
1431:
1432: true if the current state requires timeout support.
1433:
1.1 foxr 1434: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to LondConnection.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom