mirror of
https://github.com/PDP-10/its.git
synced 2026-03-28 10:52:52 +00:00
Added mail support (COMSAT, MAIL, RMAIL, DQ device).
This commit is contained in:
Eric Swenson
committed by
Lars Brinkhoff
Lars Brinkhoff
parent
05c496162e
commit
c81af35115
2
Makefile
2
Makefile
@@ -1,6 +1,6 @@
|
||||
EMULATOR ?= simh
|
||||
|
||||
SRC = system syseng sysen1 sysen2 sysnet kshack dragon channa midas _teco_ emacs rms klh syshst sra mrc ksc cstacy gren bawden
|
||||
SRC = system syseng sysen1 sysen2 sysnet kshack dragon channa midas _teco_ emacs rms klh syshst sra mrc ksc cstacy gren bawden emacs1 _mail_
|
||||
DOC = info _info_ sysdoc kshack _teco_ emacs emacs1
|
||||
MINSYS = _ sys sys2 sys3 device emacs _teco_ sysbin inquir
|
||||
|
||||
|
||||
@@ -94,6 +94,10 @@ from scratch.
|
||||
- TTLOC, Advertises physical location of logged in users
|
||||
- SRCCOM, Compares/merges source files, compares binary files
|
||||
- DDTDOC, interactive DDT documentation.
|
||||
- COMSAT, Mail server
|
||||
- MAIL, Mail sending client
|
||||
- RMAIL, Mail reading client
|
||||
- DQ Device, for doing hostname resolutions. Used by COMSAT.
|
||||
|
||||
6. A brand new host table is built from the host table source and
|
||||
installed into SYSBIN; HOSTS3 > using H3MAKE.
|
||||
@@ -110,9 +114,8 @@ Currently, basic TCP network support is in the build, in addition to
|
||||
both a TELNET/SUPDUP server, and both TELNET and SUPDUP clients.
|
||||
Additionally, both an FTP server and client are included. Chaosnet TELNET
|
||||
and FTP (CHTN and CFTP), but this requires support and configuration
|
||||
in the emulator to actually use.
|
||||
|
||||
Other network services will appear in subsequent releases.
|
||||
in the emulator to actually use. SMTP mail inbound and outbound is included,
|
||||
as well as local mail delivery.
|
||||
|
||||
The KLH10 dskdmp.ini file has an IP address (192.168.1.100) and gateway IP
|
||||
address (192.168.0.45) configured for the ITS system. The IP address
|
||||
|
||||
BIN
bin/emacs/[rmai].146
Normal file
BIN
bin/emacs/[rmai].146
Normal file
Binary file not shown.
@@ -436,6 +436,48 @@ expect ":KILL"
|
||||
respond "*" ":midas sys;ts srccom_sysen2;srccom\r"
|
||||
expect ":KILL"
|
||||
|
||||
respond "*" ":midas .mail.;comsat_sysnet;comsat\r"
|
||||
expect ":KILL"
|
||||
|
||||
respond "*" ":midas device;jobdev dq_sysnet;dqxdev\r"
|
||||
expect ":KILL"
|
||||
|
||||
respond "*" "comsat\033j"
|
||||
respond "*" "\033l.mail.;comsat bin\r"
|
||||
respond "*" "bughst/<<192.\033_24.>+<168.\033_16.>+<1.\033_8.>+100.>\r"
|
||||
type "domgat/<<192.\033_24.>+<168.\033_16.>+<0.\033_8.>+45.>\r"
|
||||
type "tcpgat/<<192.\033_24.>+<168.\033_16.>+<0.\033_8.>+45.>\r"
|
||||
type "debug/0\r"
|
||||
type "xvers/0\r"
|
||||
type "purify\033g"
|
||||
respond ":PDUMP DSK:.MAIL.;COMSAT LAUNCH" "\r"
|
||||
|
||||
respond "*" ":kill\r"
|
||||
respond "*" ":job comsat\r"
|
||||
respond "*" ":load .mail.;comsat launch\r"
|
||||
respond "*" "debug/-1\r"
|
||||
type "mfinit\033g"
|
||||
|
||||
respond "*" ":link emacs;rmail \021:ej,emacs;\[rmai\] >\r"
|
||||
|
||||
respond "*" ":midas sys1;ts rmail_emacs1;rmaill\r"
|
||||
expect ":KILL"
|
||||
|
||||
respond "*" ":link channa;rakash cnavrl,.mail.;comsat launch\r"
|
||||
respond "*" ":link dragon;hourly cnavrl,.mail.;comsat launch\r"
|
||||
|
||||
respond "*" ":midas sysbin;qmail_ksc;qmail\r"
|
||||
respond "PWORD version (Y or N)? " "Y\r"
|
||||
expect ":KILL"
|
||||
|
||||
respond "*" ":link sys;ts mail,sysbin;qmail bin\r"
|
||||
respond "*" ":link sys;ts qmail,sysbin;qmail bin\r"
|
||||
respond "*" ":link sys;ts qsend,sysbin;qmail bin\r"
|
||||
respond "*" ":link sys1;ts bug,sysbin;qmail bin\r"
|
||||
respond "*" ":link sys;ts m,sys;ts mail\r"
|
||||
respond "*" ":link sys2;ts featur,sys;ts qmail\r"
|
||||
respond "*" ":link .info.;mail info,.info.;qmail info\r"
|
||||
|
||||
respond "*" ":link kshack;good ram,.;ram ram\r"
|
||||
respond "*" ":link kshack;ddt bin,.;@ ddt\r"
|
||||
respond "*" $emulator_escape
|
||||
|
||||
148
doc/_info_/qmail.info
Normal file
148
doc/_info_/qmail.info
Normal file
@@ -0,0 +1,148 @@
|
||||
QMAIL gist:
|
||||
|
||||
:QMAIL name@site,name2@site2,...<CRLF>
|
||||
<message> ^C
|
||||
|
||||
QMAIL details:
|
||||
Qmail sends messages to people over
|
||||
the network or locally; the "Q" is for "queue" as it
|
||||
always operates by queueing mail to a special
|
||||
independent program which does the actual sending.
|
||||
It can be used as something of an adulterated DDT ":MAIL" command
|
||||
as shown above (":QMAIL FOO MESSAGE^C will work),
|
||||
but is much more useful when one knows the
|
||||
magic character... i.e., alt-mode.
|
||||
|
||||
(alt-mode) followed by:
|
||||
?- lists commands.
|
||||
T- To: <name>,<name2>,... i.e. add to mailing list.
|
||||
U- Un-to: <name>,<name2>... uh, take him off mailing list.
|
||||
'*' works as either a name or site. Alone, flushes all.
|
||||
S- Subject: specify a subject line. Null line deletes.
|
||||
F- From: <name> this command is unnecessary unless your UNAME
|
||||
is not the real you.
|
||||
A- Append <file> at end of message text.
|
||||
Q- Quit, as in :KILL
|
||||
|
||||
-----------------------------------------------
|
||||
Keyboard notes:
|
||||
^G: stops typeout
|
||||
^L: re-displays mailing list and text.
|
||||
^Q: quote next char.
|
||||
CR: safe reply to most any input request.
|
||||
RUBOUT: is moderately clever.
|
||||
ALT-MODE: command invocation, echoes as a ">" prompt.
|
||||
|
||||
(on TV's)
|
||||
META & TOP: will quote and TOPify, respectively.
|
||||
-----------------------------------------------
|
||||
|
||||
OTHER COMMANDS:
|
||||
|
||||
/- Slashification switch complement. When on, characters will
|
||||
be converted to lowercase unless preceded by a slash,
|
||||
just as in TECO. Useful for entering lower case on
|
||||
uppercase terminals such as Datapoints.
|
||||
L- List the mailing list. Useful for non-displays.
|
||||
Z- Zap, i.e. clear message buffer (but preserve mailing list)
|
||||
^C- Sends message but restarts Qmail instead of quitting.
|
||||
Note this is <alt>^C, not just plain ^C.
|
||||
|
||||
W- Write <file> containing message text. Useful if Edit-escape
|
||||
(see below) is too kludgy for you or doesn't work.
|
||||
I- Insert <file> Just like Append.
|
||||
Y- Yank <file> in as message text, anything already in message
|
||||
buffer will be flushed.
|
||||
G- Get <file> Starts reading <file> data as if it came from the
|
||||
console; information in the file will simply be added to
|
||||
whatever already exists. Commands can be given. PUT
|
||||
will write a file which GET understands.
|
||||
P- Put <file> out which contains all info necessary to recreate
|
||||
the entire message.
|
||||
|
||||
E- Edit Escape to TECO.
|
||||
This writes a file named _MAIL_ _EDIT_ on the
|
||||
directory the user's sname points to, and valrets a
|
||||
":TECO _MAIL_ _EDIT_" to DDT. In most cases,
|
||||
barring invalid system names and cranky TECO INIT's, this
|
||||
kludge will get the message thus far into a TECO
|
||||
buffer, where the user can then edit
|
||||
to his heart's content. When QMAIL is
|
||||
proceeded (not restarted!) it will try to read that
|
||||
file back into its own buffer, so after
|
||||
TECO'ing the message one should write it
|
||||
back where it came from. (EWEE) Some time in the
|
||||
future this will be replaced by a more
|
||||
winning invocation; until then, good luck.
|
||||
|
||||
R Receipt-switch complement. Default (off) means
|
||||
you will be mailed a receipt for only those
|
||||
messages which could not be sent immediately.
|
||||
If enabled, receipts will always be given.
|
||||
This dates from days of unreliable service.
|
||||
|
||||
V Variant force. Default variety of message is ITS for
|
||||
solely intra-ITS mail, TENEX for mail with one or
|
||||
more non-ITS recipients. This command will force
|
||||
format to whichever you specify. (CR restores the
|
||||
default)
|
||||
|
||||
============================================================
|
||||
Syntax of a "name" or recipient
|
||||
|
||||
The general format is <name>, <name>@<site>, or
|
||||
<name>%<site>. (From TIPs, % is easier to type).
|
||||
All reasonable host nicknames (and unique fractions thereof)
|
||||
should be recognized. Let me know if your favorite
|
||||
names aren't there.
|
||||
There are two special "name" formats with
|
||||
special effects. One is "sticky site"; giving
|
||||
a host specification (i.e., "@site") alone will
|
||||
make that host apply to all subsequent names which
|
||||
have no host spec, but only until another host
|
||||
spec is found. If this is another sticky site,
|
||||
the default host is now this new sticky site,
|
||||
otherwise it reverts to the local site regardless
|
||||
of the unsticking host spec. The idea is to
|
||||
be able to specify a site and follow it with the
|
||||
names of all recipients at that site; e.g.
|
||||
|
||||
@sail, foo1,foo2, foo3, bar @ ml,friend
|
||||
sends to FOO1, FOO2, and FOO3 at Stanford,
|
||||
BAR at Mathlab, and FRIEND locally.
|
||||
|
||||
The second special format is "(filename)"
|
||||
where the file is taken to contain a string of
|
||||
names in the same format as might be typed in;
|
||||
that is, a distribution list. The world is
|
||||
actually pushed and popped, so distribution
|
||||
lists can include the names of other lists, to
|
||||
a depth of 7 or so. E.G.
|
||||
|
||||
@ai,larry,curly,moe,(klh;people list),oof
|
||||
sends to 3 people at MIT-AI, to all the
|
||||
recipients listed in "klh;people list",
|
||||
and OOF locally.
|
||||
____________________________________________
|
||||
____________________________________________
|
||||
ADDENDUM
|
||||
|
||||
Also, there is a job (disowned, variously named
|
||||
after some communications satellite or another) which
|
||||
does the actual mailing, and enables
|
||||
network mail to be "sent" irregardless of
|
||||
remote host status; the satellite simply waits until
|
||||
the destination comes alive. If it is running,
|
||||
mail should be delivered within a minute; QMAIL
|
||||
writes the message instantly to a file and exits, but
|
||||
the satellite may take a while to notice
|
||||
the file. Note that this scheme is painless for
|
||||
messages to many recipients, to dead foreign hosts,
|
||||
and to large mail files (such as SYS).
|
||||
If the satellite is not orbiting (or otherwise screwed)
|
||||
mail will take longer, i.e. until it is restarted
|
||||
or fixed, but will eventually arrive.
|
||||
(neither crash, glitch, nor parity etc...)
|
||||
|
||||
All bugs, suggestions, etc to KLH @ AI.
|
||||
|
||||
250
doc/info/mail.12
Normal file
250
doc/info/mail.12
Normal file
@@ -0,0 +1,250 @@
|
||||
This is a first try at creating a new-style info file for QMAIL ORDER.
|
||||
Now it's a second try. Make that a third try.
|
||||
|
||||
File: MAIL Node: Top Up: (DIR) Next: Keyboard
|
||||
|
||||
MAIL is a program for sending mail to users on this machine, or any
|
||||
machine on the Arpa or Chaos nets. You can send mail to any known
|
||||
user, or to a "mailing list" of users, such as people responsible for
|
||||
maintaining a certain program. Here is the general format for mail:
|
||||
|
||||
:mail user1@site, user2@site, usern@site <crlf>
|
||||
<multiple
|
||||
line
|
||||
message>
|
||||
^C
|
||||
|
||||
To aid TIP users, mail will accept a percent sign instead of an atsign
|
||||
in site descriptions. If the atsign and the site are not present, they
|
||||
are assumed to be the present site.
|
||||
|
||||
The next node tells you about features of mail you'll use to type
|
||||
in your message text.
|
||||
|
||||
* Menu:
|
||||
|
||||
* Keyboard:: Notes on using MAIL from the keyboard.
|
||||
|
||||
* Commands:: Escape to more advanced commands.
|
||||
|
||||
* Edit:: How to escape into EMACS with your mail.
|
||||
|
||||
* Syntax:: The exact syntax of mail recipients.
|
||||
|
||||
* Internals:: A brief explanation of how the mailing system works
|
||||
behind the scenes.
|
||||
|
||||
* Announcements: (SYSMSG)
|
||||
How to read and send system-wide messages, and the
|
||||
difference between system and bboard messages.
|
||||
|
||||
* RMAIL: (RMAIL)
|
||||
RMAIL is a program for reading, editing, and replying
|
||||
to mail.
|
||||
|
||||
* Babyl: (Babyl)
|
||||
Babyl is, like RMail, an EMACS mail subsystem. It
|
||||
differs from RMail in some respects. In particular,
|
||||
it will run on TENEX and TWENEX.
|
||||
|
||||
File: MAIL Node: BUG Up: (DIR) Next: Top
|
||||
|
||||
How to complain about program bugs:
|
||||
|
||||
:BUG program<CRLF>
|
||||
<message> ^C
|
||||
|
||||
BUG is really the same program as MAIL, except that instead of giving
|
||||
the name of a user, you give the name of a program. The message is
|
||||
sent to the maintainers of that program - that is, whoever has elected
|
||||
to receive complaints about it. Doing :BUG program <CRLF> is
|
||||
equivalent to doing :MAIL BUG-program <CRLF>.
|
||||
|
||||
Here is an example:
|
||||
|
||||
:bug info
|
||||
Msg:
|
||||
The description of what bug does is unclear.
|
||||
^C
|
||||
|
||||
If there is no mailing list on the current machine for the program you
|
||||
are sending a BUG about, your message will go to BUG-RANDOM-PROGRAM, a
|
||||
mailing list of people who are generally knowledgable about the system
|
||||
and who will try to fix your bug or redirect your problem to the
|
||||
appropriate person.
|
||||
|
||||
The next node tells about the MAIL program in general.
|
||||
Most of what it says works for :BUG as well.
|
||||
|
||||
File: MAIL Node: QSEND Next: Top Up: (DIR)
|
||||
|
||||
How to send a message to people logged in at other sites:
|
||||
|
||||
:QSEND name1@site1, name2@site2,... <CRLF>
|
||||
<message> ^C
|
||||
|
||||
QSEND is really the same program as MAIL, but it is used to send
|
||||
messages to a person the way the DDT command :SEND does. The
|
||||
difference is that QSEND can send messages to users logged in at any
|
||||
site on the ARPAnet. If the person qsent to is not logged in at the
|
||||
time the message arrives at the site, the message is turned into mail
|
||||
for him or her.
|
||||
|
||||
:S is short for :QSEND, not for :SEND.
|
||||
|
||||
The next node tells about the MAIL program in general. Most of what
|
||||
it says works for :QSEND as well.
|
||||
|
||||
File: MAIL, Node: Keyboard, Previous: Top, Up: Top, Next: Commands
|
||||
|
||||
After MAIL prints out "Msg:" you can just start typing the text you
|
||||
want to send. Use rubout to delete the charcter you just typed, ^W to
|
||||
delete the last word, and ^U to delete the last line. If you are on an
|
||||
AI Knight TV, you can type Meta-Rubout (just as in EMACS) to delete
|
||||
the last word.
|
||||
|
||||
When you're through sending the message, type ^C. If you decide you
|
||||
didn't want to send the message anyway, you can type altmode Q, or ^Z
|
||||
and then :KILL.
|
||||
|
||||
Here's a summary of what various control characters do in MAIL:
|
||||
|
||||
^G: stops typeout
|
||||
^L: re-displays mailing list and text.
|
||||
^Q: quote next character (altmode or control-character).
|
||||
^R: redisplay current line.
|
||||
^W: backward delete word.
|
||||
^U: delete current line.
|
||||
^D: same as altmode.
|
||||
CR: safe reply to most any input request.
|
||||
RUBOUT: is moderately clever.
|
||||
ALT-MODE: command invocation, echoes as a ">" prompt.
|
||||
|
||||
(on AI TVs)
|
||||
META & TOP: will quote and TOPify, respectively.
|
||||
META-RUBOUT is the same as ^W.
|
||||
|
||||
The next node describes other commands which you can execute after
|
||||
typing an altmode.
|
||||
|
||||
File: MAIL, Node: Commands, Previous: Keyboard, Up: Top, Next: Edit
|
||||
|
||||
When you type an alt-mode to MAIL, it responds to a single-charactar
|
||||
command. Below is a list of the commands and a short description of
|
||||
what they do. For more information on a particular command, run
|
||||
the MAIL program and type <altmode><command character>?.
|
||||
|
||||
H Help <char>, describes given command.
|
||||
T To <recipients>, adds them to mailing list.
|
||||
C CC <recipients>, just like "TO" except the recipients get listed
|
||||
with a CC: header.
|
||||
U Un-to <recipients>, removes from mailing list. * works.
|
||||
S Subject for the mail, one line (null line deletes).
|
||||
F From <your real login name>. Unnecessary unless UNAME wrong.
|
||||
E Edit escape to EMACS. ^X^C returns to MAIL program.
|
||||
*Note Edit: Edit.
|
||||
N Name for recipient list, header shows this and not real list.
|
||||
L List the mailing list.
|
||||
W Write message text to <file>.
|
||||
A Append <file> to message text.
|
||||
I Insert <file> (exactly like Append).
|
||||
Y Yank <file> in, replacing message text.
|
||||
|
||||
G Get from <file> data as if typed from console.
|
||||
Starts reading <file> data as if it came from the console;
|
||||
information in the file will simply be added to whatever
|
||||
already exists. <file> can include commands.
|
||||
P Put to <file> a GET-able description of message.
|
||||
Z Zaps message buffer, and gives you an empty one.
|
||||
Careful -- doesn't require confirmation.
|
||||
|
||||
M Mode switching (mail, send, notification, etc).
|
||||
V Variant force, specify type of header to use.
|
||||
Default variety of message is ITS for solely intra-ITS mail,
|
||||
TENEX for mail with one or more non-ITS recipients. This
|
||||
command will force format to whichever you specify. (CR
|
||||
restores the default).
|
||||
R Receipt mode select - All, Queued, or Failed.
|
||||
Default (off) means you will be mailed a receipt for only
|
||||
those messages which could not be sent immediately. If
|
||||
enabled, receipts will always be given. This dates from days
|
||||
of unreliable service.
|
||||
|
||||
/ Slash switch complement (ON = case conversion like TECO).
|
||||
When on, characters will be converted to lowercase unless
|
||||
preceded by a slash, just as in TECO. Useful for entering
|
||||
lower case on terminals such as Datapoints.
|
||||
|
||||
X (* msgs only) Xpiration date in days.
|
||||
1 (* msgs only) 1st filename for .MSGS.; file.
|
||||
2 (* msgs only) 2nd filename for .MSGS.; file.
|
||||
(For more information on system and bboard messages see
|
||||
*Note Announcements: (SYSMSG). )
|
||||
|
||||
Q Quit Asks for confirmation.
|
||||
|
||||
File: MAIL, Node: Edit, Previous: Commands, Up: Top, Next: Syntax
|
||||
|
||||
Type altmode-E to MAIL to escape to EMACS. ^X^C returns to the MAIL
|
||||
program.
|
||||
|
||||
An inferior EMACS is created, and the current message text loaded into
|
||||
it for editing. One may normally exit from EMACS, and have the
|
||||
current buffer loaded back as the new message text, by typing ^X ^C.
|
||||
(Executing FSEXIT or typing ^C in non-^R-mode will also return). ^K
|
||||
(valret) as a bare-TECO command will be completely ignored!! ^Z will
|
||||
safely interrupt MAIL.
|
||||
|
||||
File: MAIL, Node: Syntax, Previous: Edit, Up: Top, Next: Internals
|
||||
|
||||
Syntax of a "name" or recipient
|
||||
|
||||
The general format is <name>, <name>@<site>, or <name>%<site>. (From
|
||||
TIPs, % is easier to type). All reasonable host nicknames (and unique
|
||||
fractions thereof) should be recognized. Complain to BUG-MAIL if your
|
||||
favorite names aren't there.
|
||||
|
||||
Certain names are recognized specially by mail. They begin with an
|
||||
asterisk, and go the the "Bulletin Boards" of various systems.
|
||||
*Note Announcements: (SYSMSG).
|
||||
|
||||
There is a special format of name referred to as "sticky site"; giving
|
||||
a host specification (i.e., "@site") alone will make that host apply
|
||||
to all subsequent names which have no host spec, but only until
|
||||
another host spec is found. If this is another sticky site, the
|
||||
default host is now this new sticky site, otherwise it reverts to the
|
||||
local site regardless of the unsticking host spec. The idea is to be
|
||||
able to specify a site and follow it with the names of all recipients
|
||||
at that site; e.g., mail addressed to
|
||||
@sail, foo1,foo2, foo3, bar@ml,friend
|
||||
goes to FOO1, FOO2, and FOO3 at Stanford, BAR at Mathlab, and
|
||||
FRIEND at the local host.
|
||||
|
||||
When sending to a Comsat site (AI, ML, or MC), you may use special
|
||||
formats such as (BUG program-name) which reports a bug in a program,
|
||||
(FILE [dir;name1 name2]) which appends to the specified file, and
|
||||
(@FILE [dir;name1 name2]), which reads a mailing list from the file
|
||||
and mails to the people in it.
|
||||
|
||||
File: MAIL Node: Internals, Previous: Syntax Up: Top
|
||||
|
||||
There is a job (disowned, variously named after some communications
|
||||
satellite or another) which does the actual mailing, and enables
|
||||
network mail to be "sent" irregardless of remote host status; the
|
||||
satellite simply waits until the destination comes alive. If this
|
||||
program is not running, MAIL will try to start it (a rare occurrence
|
||||
hopefully); in any case mail should be delivered within 10 seconds for
|
||||
local messages. What happens is that MAIL writes the message to a
|
||||
disk file and exits, and the alerted satellite gobbles it up for
|
||||
sending. Note that this scheme is painless for large messages,
|
||||
messages to many recipients, to dead foreign hosts, and to large mail
|
||||
files (such as SYS). If the satellite is not orbiting (or otherwise
|
||||
screwed) mail will take longer, i.e. until it is restarted or fixed,
|
||||
but will eventually arrive. (neither crash, glitch, nor parity
|
||||
error will stay this untiring....)
|
||||
|
||||
For information on the internal operation of announcements (system and
|
||||
bulletin-board messages) see *Note Announcements:(SYSMSG).
|
||||
|
||||
Send bugs, suggestions, etc. to BUG-MAIL@AI.
|
||||
|
||||
150
src/_mail_/names.2006
Normal file
150
src/_mail_/names.2006
Normal file
@@ -0,0 +1,150 @@
|
||||
;;; -*- Fundamental -*-
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;
|
||||
;;; This file belongs on MD. DO NOT COPY TO OTHER MACHINES!!
|
||||
;;;
|
||||
;;; The format of this file is documented in .MAIL.;NAMES INFO.
|
||||
;;; You should read that before modifying it. Also, there are
|
||||
;;; restrictions on tourists creating mailing lists; see
|
||||
;;; AI:ACOUNT;TURIST POLICY.
|
||||
;;;
|
||||
;;; If you DO mung this file, after writing it out look for a file
|
||||
;;; called "NNAMED ERRnnn" or "NAMED ERRnnn" to appear, where nnn is
|
||||
;;; the same version number you wrote. This file will tell you if you
|
||||
;;; won or not, hopefully with explanations if it didn't. If this
|
||||
;;; report file DOESN'T appear, either the mailer isn't around, or is
|
||||
;;; busy, or is falling down in flames. (Congratulations!)
|
||||
;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; Try to use only domain-style host names.
|
||||
; (Except for specially known ITS hosts.)
|
||||
|
||||
|
||||
;;; Various special sacred lists - don't mung these!
|
||||
|
||||
(SYS-OPERATING-TROUBLE (EQV-LIST EJS))
|
||||
(MAGIC-DRAGON-KEEPER (EQV-LIST EJS))
|
||||
|
||||
; Mail maintenance stuff. Do not fuck with this.
|
||||
(BUG-MAIL (EQV-LIST BUG-QMAIL))
|
||||
(BUG-MAILER (EQV-LIST BUG-QMAIL))
|
||||
(BUG-QMAIL (EQV-LIST BUG-MAIL-AND-POSTMASTER EJS
|
||||
[KSC;MAIL BUGS]))
|
||||
(BUG-MAIL-AND-POSTMASTER (EQV-LIST EJS))
|
||||
(POSTMASTER (EQV-LIST BUG-MAIL-AND-POSTMASTER))
|
||||
(MAIL-DIR-MAINT (EQV-LIST EJS))
|
||||
(MAIL-MAINTAINERS (EQV-LIST ([.MAIL.;FAILED STUFF] (R-OPTION FAST-APPEND))))
|
||||
(COMSAT (EQV-LIST MAIL-MAINTAINERS))
|
||||
(DEAD-MAIL-RECEIPTS (EQV-LIST [NUL:])) ; out for dead msgs
|
||||
;; See message about this in mc:.mail.;names:
|
||||
(NET-ORIGIN (EQV-LIST ; ([.MAIL.;FAILED NETORG] (R-OPTION FAST-APPEND))
|
||||
MAIL-MAINTAINERS))
|
||||
|
||||
|
||||
; Inquire database daemon. These are needed in order to update
|
||||
; the database!
|
||||
(UPDATE-ITS-INQUIR (EQV-LIST
|
||||
;;UPDATE-INQUIR@NX
|
||||
;; UPDATE-INQUIR@AI UPDATE-INQUIR@MC
|
||||
;; UPDATE-INQUIR@ML
|
||||
;;UPDATE-INQUIR@MD
|
||||
UPDATE-INQUIR@ES
|
||||
))
|
||||
(UPDATE-INQUIR (EQV-LIST ([INQUIRE;INQUPD RECORD] (R-OPTION APPEND))
|
||||
[INQUIR;.UPD1. >]
|
||||
(PGM [INQUIR;INQUPD BIN]
|
||||
(R-PGM-MNTNR BUG-INQUIR)
|
||||
(R-PGM-DISOWN 6))))
|
||||
(UPDATE-INQUIR-LOSSAGE (EQV-LIST [NUL:INQUIR;INQUPD BARFS]))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Here is the stuff for *MSG message hackery. Any name beginning with "*"
|
||||
;;; is by default of type *MSG, and will be given a *MSG-style header unless
|
||||
;;; otherwise forced.
|
||||
;;; All *MSG-type recipients will appear in the DISTRIB field, unless
|
||||
;;; they have the NOTDIST option. Any attempt to actually send the message
|
||||
;;; to a *MSG-type rcpt will throw away the name itself and send instead
|
||||
;;; to the file [DSK:.MSGS.;1 2] where 1 and 2 default to *MSG and > unless
|
||||
;;; explicitly specified via MSG-FN1 and MSG-FN2.
|
||||
|
||||
;; The entry for "*" is the only one which varies in the NAMES file for
|
||||
;; each site.
|
||||
(* (R-OPTION NOTDIST) (EQV-LIST *ES))
|
||||
;; *msg mailing lists -- see .MAIL.;BBOARD INFO for accepted policy on
|
||||
;; which list to use for what purpose.
|
||||
;(*MIT (R-OPTION NOTDIST)
|
||||
; (EQV-LIST *MAC *CIPG *DSPG *INFOODS *LIDS *PFC *XV *AMT *RANDOMS))
|
||||
;(*MAC (R-OPTION NOTDIST)
|
||||
; (EQV-LIST *ITS *HX *LCS-UVAX *MLSITE *REAGAN *THEORY *WH))
|
||||
(*TENS (R-OPTION NOTDIST) (EQV-LIST *ITS))
|
||||
(*ITS (R-OPTION NOTDIST) (EQV-LIST
|
||||
ES
|
||||
;;*NX
|
||||
;; *AI *MC
|
||||
;; *MD *ML
|
||||
))
|
||||
;; BBOARD goes most everywhere but is not shown by :MSGS by default
|
||||
;(BBOARD (EQV-LIST (*BBOARD)))
|
||||
;(*BBOARD (EQV-LIST *MSGS-TO-ITSES
|
||||
; (*REAGAN (R-OPTION NOTDIST)) (*WH-BBOARD (R-OPTION NOTDIST))
|
||||
; (*HX (R-OPTION NOTDIST)) (*LCS-UVAX (R-OPTION NOTDIST))
|
||||
; (*MLSITE (R-OPTION NOTDIST))
|
||||
; (*THEORY-BBOARD (R-OPTION NOTDIST))
|
||||
; (*AMT (R-OPTION NOTDIST))
|
||||
; (*EDDIE (R-OPTION NOTDIST))
|
||||
; (*INFOODS (R-OPTION NOTDIST))
|
||||
; (*LIDS (R-OPTION NOTDIST))
|
||||
; (*PFC (R-OPTION NOTDIST))
|
||||
; (*RANDOMS (R-OPTION NOTDIST))))
|
||||
|
||||
;; Hosts that can receive *msgs
|
||||
;;(*NX (EQV-LIST *MSGS-TO-ITSES))
|
||||
;; (*AI (EQV-LIST *MSGS-TO-ITSES))
|
||||
;; (*MC (EQV-LIST *MSGS-TO-ITSES))
|
||||
;; (*ML (EQV-LIST *MSGS-TO-ITSES))
|
||||
;;(*MD (EQV-LIST *MSGS-TO-ITSES))
|
||||
(*ES (EQV-LIST *MSGS-TO-ITSES))
|
||||
(*MSGS-TO-ITSES (R-OPTION NOTDIST) ; This just makes above 4 simpler.
|
||||
(EQV-LIST
|
||||
;;(*MSG-SINK@NX (R-OPTION NOTDIST))
|
||||
;; (*MSG-SINK@AI (R-OPTION NOTDIST))
|
||||
;; (*MSG-SINK@MC (R-OPTION NOTDIST))
|
||||
;; (*MSG-SINK@ML (R-OPTION NOTDIST))
|
||||
;; (*MSG-SINK@MD (R-OPTION NOTDIST))
|
||||
(*MSG-SINK@ES (R-OPTION NOTDIST))
|
||||
))
|
||||
; This is final "sink". Mailer converts to filename specially.
|
||||
(*MSG-SINK (R-OPTION NOTDIST))
|
||||
|
||||
; Messages addressed to a BUG-type recipient that doesn't exist are
|
||||
; vectored to (BUG RANDOM-PROGRAM) instead, at a host address patched
|
||||
; into COMSAT at location BUGHST.
|
||||
|
||||
(BUG-RANDOM-PROGRAM (EQV-LIST EJS))
|
||||
|
||||
|
||||
;; The remaining names are not necessary to the operation of ITS but
|
||||
;; are generally useful, I suppose.
|
||||
|
||||
; Plausible generic contact names.
|
||||
(NETWORK-LIAISON (EQV-LIST EJS))
|
||||
(LIASON (EQV-LIST NETWORK-LIAISON))
|
||||
(LIAISON (EQV-LIST NETWORK-LIAISON))
|
||||
(ACTION (EQV-LIST NETWORK-LIAISON))
|
||||
|
||||
; Personal lists and stuff.
|
||||
|
||||
(EJS (EQV-LIST [EJS;EJS MAIL])) ; Avoid clash with INQUIR mail address
|
||||
|
||||
(INFO-EJS10 (EQV-LIST
|
||||
([EJS;EJS10 ARCHIV] (R-OPTION FAST-APPEND)) ; Msg log
|
||||
(@FILE [EJS;EJS10 PEOPLE]) ; Distrib list
|
||||
))
|
||||
|
||||
(ACCOUNTS-NOTIFICATION (EQV-LIST EJS))
|
||||
(USER-ACCOUNTS (EQV-LIST EJS))
|
||||
(ACCOUNTS-HELD-REFUSED (EQV-LIST EJS))
|
||||
(USER-ACCOUNTS-ARCHIVE (EQV-LIST EJS))
|
||||
(PASSWORD-SYSTEM (EQV-LIST EJS))
|
||||
(BUGGY-PWORD (EQV-LIST EJS))
|
||||
37
src/emacs1/rmaill.8
Executable file
37
src/emacs1/rmaill.8
Executable file
@@ -0,0 +1,37 @@
|
||||
; -*- MIDAS -*-
|
||||
|
||||
TITLE RMAIL LOADER
|
||||
|
||||
;Assemble this into SYS1; TS RMAIL.
|
||||
;Runs SYS2;TS EMACS with jcl of "2,MM RMAIL" and whatever JCL you gave it.
|
||||
;The "2," causes it to kill itself if exited with Q but not if exited
|
||||
;temporarily with ^X. Also have to save and restore Q9 which it smashes somewhere.
|
||||
;Only works under DDT.
|
||||
|
||||
A=1
|
||||
B=2
|
||||
C=3
|
||||
D=4
|
||||
E=5
|
||||
P=17
|
||||
|
||||
VAL: ASCII / :JCL / ;10 characters
|
||||
JCL: ASCII /[9 2,MM RMAIL/ ;15 characters
|
||||
JCL1: BLOCK 200 ;Original JCL here
|
||||
|
||||
GO: .BREAK 12,[5,,JCL1] ;Get jcl
|
||||
MOVE A,[440700,,JCL1] ;Find end of it
|
||||
FEND: ILDB C,A
|
||||
CAIE C,^C
|
||||
CAIN C,^M
|
||||
JRST FENDD
|
||||
JUMPN C,FEND
|
||||
FENDD: MOVEI C,"
|
||||
DPB C,A
|
||||
MOVE B,[440700,,[ASCIZ /]9î:LOAD DSK:SYS2;TS EMACSî:GOî/]]
|
||||
PLOAD: ILDB C,B
|
||||
IDPB C,A
|
||||
JUMPN C,PLOAD
|
||||
.VALUE VAL
|
||||
|
||||
END GO
|
||||
79
src/ksc/ivory.12
Normal file
79
src/ksc/ivory.12
Normal file
@@ -0,0 +1,79 @@
|
||||
comment |
|
||||
Definitions for purifying and relocating variables into
|
||||
impure low core. BVAR and EVAR should bracket each group of
|
||||
variables, which by definition are impure. LVAR may be used
|
||||
for single-line variable definitions.
|
||||
|
||||
PURPGB specifies page no. beginning pure code;
|
||||
VARBEG specifies loc beginning variable (impure) code. Note that
|
||||
PURPGB is a page number, while VARBEG is a location.
|
||||
|
||||
VARCHK is a macro which should be called at the end of the program to
|
||||
ensure that pure and impure storage areas do not overlap, and to
|
||||
put MIDAS variables (foo', .scalar foo, etc) in the impure area.
|
||||
It may be called more than at various places throughout the program,
|
||||
and each time will define PURPGE to be the first page unused by pure core.
|
||||
|
||||
TMPLOC <loc>,{text} will assemble specified text at <loc> and restore
|
||||
the loc counter automatically.
|
||||
|
||||
To purify, use something like:
|
||||
MOVE A,[<purpgb-purpge>,,purpgb]
|
||||
.CALL [SETZ ? 'CORBLK ? 1000,,%CBNDR
|
||||
1000,,%JSELF ? A ? SETZI %JSELF]
|
||||
|
|
||||
|
||||
ifndef purpgb, purpgb==1 ; 1st pure page normally 1; single impure at 0.
|
||||
ifndef varbeg, varbeg==100 ; Variables normally start at location 100
|
||||
|
||||
; Initialize internal syms for B/EVAR
|
||||
%%pbeg==2000*purpgb ; Loc of 1st pure wd
|
||||
%%pend==%%pbeg ; Used to remember pure loc while assembling variables.
|
||||
%%vend==varbeg ; Current first unused loc for vars
|
||||
%%vflg==0 ; 1 when assembling into var area, 0 otherwise.
|
||||
loc %%pbeg ; Start assembling into pure!
|
||||
|
||||
define bvar
|
||||
ifn %%vflg,.err BVAR inside BVAR!
|
||||
.m"%%vflg==1
|
||||
.m"%%pend==.
|
||||
loc %%vend
|
||||
termin
|
||||
|
||||
define evar
|
||||
ife %%vflg,.err EVAR without BVAR!
|
||||
.m"%%vflg==0
|
||||
.m"%%vend==.
|
||||
loc %%pend
|
||||
termin
|
||||
|
||||
define lvar -line
|
||||
bvar
|
||||
line
|
||||
evar
|
||||
termin
|
||||
|
||||
ifndef tmploc,{
|
||||
define tmploc val,?arg
|
||||
%%%tlc==.
|
||||
loc val
|
||||
arg
|
||||
loc %%%tlc
|
||||
termin }
|
||||
|
||||
define errmac a,b,c,d,e,f
|
||||
.err a!b!c!d!e!f
|
||||
termin
|
||||
|
||||
define varchk
|
||||
lvar variables ; Do this first; LVAR will set %%PEND properly
|
||||
.m"purpge==<%%pend+1777>/2000
|
||||
ifg varbeg-%%pbeg,{ifl .-varbeg,{
|
||||
errmac [Pure overflow! ]\<.-varbeg>,[ words needed, increase VARBEG to ]\.,[?]
|
||||
}
|
||||
}
|
||||
ifle varbeg-%%pbeg,{ifl %%pbeg-%%vend,{
|
||||
errmac [Impure overflow! ]\<%%vend-%%pbeg>,[ words needed, increase PURPGB to ]\<<1777+%%vend>/2000>,[?]
|
||||
}
|
||||
}
|
||||
termin
|
||||
1312
src/ksc/nlists.124
Normal file
1312
src/ksc/nlists.124
Normal file
File diff suppressed because it is too large
Load Diff
4801
src/ksc/qmail.614
Normal file
4801
src/ksc/qmail.614
Normal file
File diff suppressed because it is too large
Load Diff
11864
src/sysnet/comsat.583
Normal file
11864
src/sysnet/comsat.583
Normal file
File diff suppressed because it is too large
Load Diff
699
src/sysnet/dqxdev.41
Normal file
699
src/sysnet/dqxdev.41
Normal file
@@ -0,0 +1,699 @@
|
||||
;;; -*-Midas-*-
|
||||
|
||||
title DQXDEV -- Fake DQDEV so COMSAT won't keep barfing its cookies
|
||||
|
||||
;;; If you think this looks a lot like LPDEV, you're right.
|
||||
|
||||
;;; Accumulators
|
||||
|
||||
a==:1
|
||||
b==:2
|
||||
c==:3
|
||||
d==:4
|
||||
e==:5
|
||||
t==:6
|
||||
tt==:7
|
||||
|
||||
x==:10 ; used in RENMWO code as CH/IN index
|
||||
y==:11 ; used in SIOT code to handle PCLSRing
|
||||
; what the hell, make these ACs too
|
||||
rrptr==:15 ; Pointer to buffered answer
|
||||
rrecnt==:16 ; Byte count of buffered answer
|
||||
|
||||
p=:17
|
||||
|
||||
;;; Channels
|
||||
|
||||
tty==:1 ; for debugging
|
||||
boj==:2 ; for talking to the user
|
||||
dsk==:3 ; for reading HOSTS3
|
||||
|
||||
;;; Flags
|
||||
|
||||
%f==:0,,525252 ; Flags in RH(0)
|
||||
%fdbug==:000100 ; Being debugged as an OJB server under DDT
|
||||
%fval==: 000200 ; BOJ interrupts clear this "valid" bit
|
||||
%frwo==: 000400 ; User last seen in a RENMWO
|
||||
%fiot==: 001000 ; User last seen in an IOT
|
||||
%fsiot==:002000 ; User last seen in a SIOT
|
||||
%fclos==:004000 ; User last seen in a CLOSE
|
||||
|
||||
;;; Instructions and macros
|
||||
|
||||
.insrt system;t20mac >
|
||||
|
||||
call=: pushj p,
|
||||
ret=: popj p,
|
||||
pause=: .break 16,100000
|
||||
tyo=: .iot tty,
|
||||
nop=: jfcl
|
||||
|
||||
retskp=:jrst .
|
||||
rskp: aos (p)
|
||||
r: ret
|
||||
|
||||
quit=: call .
|
||||
$quit: trne %fdbug
|
||||
pause
|
||||
.logout 1,
|
||||
|
||||
define syscall name,args
|
||||
.call [setz ? sixbit /name/ ? args(400000)]
|
||||
termin
|
||||
|
||||
define report &text&
|
||||
call [ trnn %fdbug
|
||||
ret
|
||||
call $report
|
||||
.length text
|
||||
ascii text]
|
||||
termin
|
||||
|
||||
$repor: exch t,(p)
|
||||
push p,tt
|
||||
move tt,0(t)
|
||||
movei t,1(t)
|
||||
hrli t,440700
|
||||
tyo [^P]
|
||||
tyo ["A]
|
||||
syscall siot,[movei tty ? t ? tt]
|
||||
.lose %lssys
|
||||
tyo [^P]
|
||||
tyo ["A]
|
||||
pop p,tt
|
||||
pop p,t
|
||||
ret
|
||||
|
||||
define barf code
|
||||
jrst [movsi tt,code ? jrst $barf]
|
||||
termin
|
||||
|
||||
$barf: .call joberr
|
||||
quit
|
||||
quit
|
||||
|
||||
$$arpa==1
|
||||
$$chaos==1
|
||||
$$hostnm==1
|
||||
$$symlook==1
|
||||
.insrt syseng;netwrk
|
||||
|
||||
.vector pdl(lpdl==:50.)
|
||||
|
||||
go: setz ; clear flags
|
||||
move p,[-lpdl,,pdl-1]
|
||||
.suset [.roption,,a]
|
||||
tlnn a,%opddt
|
||||
jrst noddt
|
||||
tro %fdbug
|
||||
tlo a,%opojb
|
||||
.open tty,[.uao\%tjdis,,'tty ? setz ? setz]
|
||||
.lose %lssys
|
||||
.value [asciz ""]
|
||||
noddt: tlo a,%opint\%opopc
|
||||
move tt,[-3,,[ .soption,,a
|
||||
.smsk2,,[1_boj]
|
||||
.sdf2,,[1_boj]
|
||||
]]
|
||||
.suset tt
|
||||
report "Ready..."
|
||||
.open boj,[.uio,,'boj ? setz ? setz]
|
||||
quit
|
||||
move tt,[-loargs,,oargs]
|
||||
.call jobcal
|
||||
quit
|
||||
tlne t,%jgcls ; Why does this happen?
|
||||
quit
|
||||
hrrzs t
|
||||
caie t,%joopn ; better be an open call
|
||||
barf %enrdv ; it wasn't, device not ready
|
||||
hrrz t,omode
|
||||
caie t,.uii ; only mode we support
|
||||
barf %ensmd
|
||||
setzm hstdat ; No table mapped in yet so no table date
|
||||
setzm chkdat ; Never checked it either
|
||||
.call jobrt0 ; tell user we're open
|
||||
quit
|
||||
|
||||
tro %fval ; Haven't taken any interrupts yet...
|
||||
report "opened, enabling PI"
|
||||
.suset [.sdf2,,[0]] ; Enable BOJ interrupts
|
||||
; fall into noose
|
||||
|
||||
noose: trne %fval ; Do we understand the situation?
|
||||
.hang ; Yes: Twiddle thumbs
|
||||
report "MP wakeup"
|
||||
tro %fval ; Set valid flag
|
||||
trne %fclos ; Trying to close?
|
||||
quit ; Yup, do it
|
||||
trne %frwo ; New query to process?
|
||||
jrst query ; Yup, go do it
|
||||
trne %fiot\%fsiot ; User wants to read something?
|
||||
jrst output ; Yup, send it off
|
||||
trne %fval ; Still valid and didn't dispatch?
|
||||
report "MP wakeup for no apparent reason"
|
||||
jrst noose ; Go try again in any case
|
||||
|
||||
;; jrst here at MP level when user wants to read from us
|
||||
output: report "client output request"
|
||||
move a,iotcnt ; how many bytes user wants
|
||||
caml a,rrecnt ; more than we have?
|
||||
move a,rrecnt ; yeah, just give what's available
|
||||
move b,a ; remember how much we are offering
|
||||
move c,iotcnt ; save count (timing screw)
|
||||
movei y,1 ; pclsr protection (also see bojint handler)
|
||||
trnn %fval ; still valid?
|
||||
jrst noose ; no, punt
|
||||
ifn. a ; if we have something to give
|
||||
xct [nop ? .call siot](y) ; do it
|
||||
xct [nop ? .lose %lssys](y) ; handle errors
|
||||
sub a,b ; count off what we gave to user
|
||||
addm a,rrecnt
|
||||
endif.
|
||||
camn b,c ; gave a different amount than user wanted?
|
||||
ifskp. ; yup, have to unblock user
|
||||
trne %fval ; don't bother if doesn't care
|
||||
.call jobrt0 ; unblock
|
||||
nop ; oh well, we tried
|
||||
endif.
|
||||
jrst noose ; dismiss again
|
||||
|
||||
;; .CALL SIOT
|
||||
siot: setz ? sixbit 'siot' ? movei boj ? rrptr ? setz a
|
||||
|
||||
|
||||
|
||||
.scalar rrecs(lrrecs==400) ; biiig buffer
|
||||
.scalar qname(64./5)
|
||||
.scalar qtype(2),qclass
|
||||
|
||||
;; jrst here at MP level to read RENMWO filenames, HOSTS3, and setup answer
|
||||
query: report "processing new request"
|
||||
call mapin ; map in HOSTS3 if needed
|
||||
trnn %fval ; might take a while, see if should abort
|
||||
jrst noose ; yup
|
||||
report "snarfing long filename"
|
||||
call snarf ; get long filename from user
|
||||
jrst noose ; snarf lost somehow
|
||||
trnn %fval
|
||||
jrst noose
|
||||
report "processing query"
|
||||
call parse ; parse funny long filename and lookup in table
|
||||
jrst noose ; lost (already JOBERRed), punt
|
||||
trnn %fval ; make sure still valid
|
||||
jrst noose
|
||||
report "JOBRETing from RENMWO"
|
||||
.call jobrt0 ; still valid, try to return it to user
|
||||
nop ; oh well
|
||||
jrst noose ; done in any case
|
||||
|
||||
badarg: movsi tt,%ebdrg ; meaningless argument
|
||||
.call joberr
|
||||
ret
|
||||
|
||||
pagmsk==:0,,776000 ; mask for page field of address
|
||||
|
||||
.scalar path(100)
|
||||
|
||||
snarf: setzm path ; paranoia
|
||||
skipn xptr ; string pointer in user space
|
||||
jrst badarg ; sorry, no sixbit domain names!
|
||||
ldb a,[.bp pagmsk,xptr] ; client's page address
|
||||
movei b,clntpg ; our page address
|
||||
.uset boj,[.ruindex,,c] ; client's job index
|
||||
tlo c,400000 ; make into job spec
|
||||
syscal corblk,[movei %cbndr ? movei %jself ? b ? c ? a]
|
||||
ret ; give up if can't get at least first page
|
||||
aos a ? aos b ; try second page in case -long- pathname
|
||||
syscal corblk,[movei %cbndr ? movei %jself ? b ? c ? a]
|
||||
nop ; not that important
|
||||
move a,[440700,,path] ; cons up pathname
|
||||
move b,xptr ; get client context pointer
|
||||
movei c,clntpg ; page where we mapped it
|
||||
dpb c,[.bp pagmsk,b] ; bash in our page number
|
||||
hlre c,xptr ; get lh of pointer
|
||||
skipn c ; lazy bp?
|
||||
hrli b,440700 ; yup, fix it up
|
||||
jumpge c,.+3 ; check for aobjn type pointer
|
||||
caml c,[-63.] ; ( -1 .ge. x .ge. -63 )
|
||||
jrst badarg ; is aobjn pointer, tough noogies
|
||||
; got good bp, copy string
|
||||
ildb c,b ; get a byte
|
||||
idpb c,a ; dump a byte
|
||||
jumpn c,.-2 ; keep going till null
|
||||
move a,[-2,,clntpg] ; unmap client page(s)
|
||||
syscal corblk,[movei ? movei %jself ? a]
|
||||
nop ; not that important (I hope!)
|
||||
retskp
|
||||
|
||||
.scalar hstdat ; date of last table gobbled
|
||||
.scalar chkdat ; date of last check
|
||||
minchk==2*60.*5 ; five minutes (in half sec units)
|
||||
|
||||
mapin: syscal rqdate,[movem a ? movem b]
|
||||
.lose
|
||||
move c,a ; current time, hang onto it
|
||||
sub a,chkdat ; how long since last check
|
||||
jumpl b,.+3 ; clock not set, better check
|
||||
caige a,minchk ; long enough wait?
|
||||
ret ; nah, we just did that
|
||||
movem c,chkdat ; remember time of this check
|
||||
syscal open,[movsi .bii ? movei dsk ? [sixbit 'dsk'] ; <
|
||||
[sixbit 'HOSTS3'] ? [sixbit '>'] ? [sixbit 'SYSBIN']]
|
||||
.lose %lsfil ; Look up creation date of host table
|
||||
syscal rfdate,[movei dsk ? movem a] ; Get creation time.
|
||||
.lose %lssys
|
||||
came a,hstdat ; Compare with time of last file gobbled
|
||||
ifskp. ; is same?
|
||||
.close dsk, ; yeah, close channel and exit
|
||||
ret
|
||||
endif.
|
||||
movem a,hstdat ; Note new version to map in.
|
||||
report "reading new HOSTS3"
|
||||
movei a,hstpag
|
||||
movei b,dsk
|
||||
call netwrk"hstmap ; Map in host table and close channel.
|
||||
.lose
|
||||
ret ; done
|
||||
|
||||
|
||||
;;; PARSE - Parse the ASCIZ pathname from PATH.
|
||||
;;; Skips if pathname appears to be properly formed.
|
||||
;;; If non-skip, gives JOBERR with appropriate code.
|
||||
|
||||
;;; mask for uppercasing single word of ascii
|
||||
ucmask: .byte 7 ? 40 ? 40 ? 40 ? 40 ? 40 ? .byte
|
||||
|
||||
parse: move a,[440700,,path]
|
||||
setz b,
|
||||
move c,[-1,,":]
|
||||
call parnxt ; skip over device name.
|
||||
jrst parluz
|
||||
setz b, ; skip over query opcode (!!)
|
||||
move c,[-1,,";]
|
||||
call parnxt ; find query opcode.
|
||||
jrst parluz
|
||||
move b,[440700,,qclass]
|
||||
move c,[-1,,";]
|
||||
setzm qclass
|
||||
call parnxt ; find class token.
|
||||
jrst parluz
|
||||
move b,[440700,,qtype]
|
||||
setzm qtype
|
||||
call parnxt ; find type token.
|
||||
jrst parluz
|
||||
move b,[440700,,qname]
|
||||
setzb c,qname
|
||||
call parnxt ; find qname
|
||||
.lose ; never happens
|
||||
move a,ucmask ; uppercasify
|
||||
andcab a,qclass ; all valid names are short...
|
||||
came a,[ascii "IN"] ; check two classes we know
|
||||
camn a,[ascii "CH"]
|
||||
ifskp. ; neither of them, punt
|
||||
movsi tt,%ensdr ; bad class
|
||||
.call joberr ; give error to user
|
||||
nop ; ignore lossage
|
||||
ret ; failing return
|
||||
endif.
|
||||
setzm rrecs ; clear out answer buffer
|
||||
move tt,[rrecs,,rrecs+1]
|
||||
blt tt,rrecs+lrrecs-1
|
||||
setzm rrecnt ; no characters yet
|
||||
move tt,[444400,,rrecs] ; bp for output routine
|
||||
movem tt,rrptr
|
||||
move a,ucmask ; uppercasify
|
||||
andcab a,qtype ; all valid types also short
|
||||
camn a,[ascii "A"] ; dispatch on valid qtypes
|
||||
jrst qt.a
|
||||
camn a,[ascii "PTR"]
|
||||
jrst qt.ptr
|
||||
camn a,[ascii "HINFO"]
|
||||
jrst qt.hin
|
||||
movsi tt,%ensdr ; bad qtype
|
||||
.call joberr ; give error to user
|
||||
nop ; ignore lossage
|
||||
ret ; failing return
|
||||
|
||||
parluz: movsi tt,%ebdfn ; Here if pathname seems to
|
||||
.call joberr ; be malformed (illegal file name).
|
||||
nop ; give error to user
|
||||
ret ; and return failure
|
||||
|
||||
;;; PARNXT gets the next token from A into B.
|
||||
;;; RH C is break char, LH C is -1 to ignore spaces.
|
||||
|
||||
parnxt: do.
|
||||
ildb t,a ; get char.
|
||||
cain t,(c) ; if delimiter return win
|
||||
exit.
|
||||
jumpe t,r ; if null, return lose
|
||||
cain t,40 ; if space and we're suppose to skip spaces
|
||||
jumpl c,top. ; then do so
|
||||
skipe b ; if b nonzero bp
|
||||
idpb t,b ; copy chars
|
||||
loop. ; next
|
||||
enddo.
|
||||
setz t, ; ascizify
|
||||
skipe b
|
||||
idpb t,b
|
||||
retskp
|
||||
|
||||
;; here for PTR rr fake
|
||||
qt.ptr: move a,qclass ; which type of foo-ADDR are we lookinf for?
|
||||
came a,[ascii "CH"] ; Chaosnet?
|
||||
tdza x,x ; no (IN: x=0)
|
||||
movei x,1 ; yes (CH: x=1)
|
||||
move t,[440700,,qname] ; find length of name
|
||||
call strlen
|
||||
move a,t ; save that
|
||||
move b,[440700,,[asciz ".IN-ADDR.ARPA"] ; trailer string
|
||||
440700,,[asciz ".CH-ADDR.MIT.EDU"]](x)
|
||||
move t,b ; get its length
|
||||
call strlen
|
||||
sub a,t ; get difference
|
||||
ifg. a ; better be something left!
|
||||
adjbp a,[440700,,qname] ; point at where trailer should be
|
||||
call strcmp ; strings match?
|
||||
anskp. ; yup
|
||||
setz t, ; tie off string
|
||||
idpb t,a
|
||||
call @[nin.in ? nin.ch](x) ;call appropriate number parser
|
||||
anskp. ; if that wins we have host number in B
|
||||
else. ; address spec bogus somehow
|
||||
movsi tt,%ebdfn ; bad filename
|
||||
trne %fval ; don't bother jobreting if not valid
|
||||
.call joberr ; still valid, punt the luser
|
||||
nop ; oh well
|
||||
ret ; return failure
|
||||
endif.
|
||||
call netwrk"hstsrc ; look up the host
|
||||
ifskp. ; did that win?
|
||||
hrli a,440700 ; yup, make bp
|
||||
move tt,[-lrrecs,,rrecs]
|
||||
call outstr ; dump string to output buffer
|
||||
retskp ; return win
|
||||
else. ; hstsrc failed
|
||||
movsi tt,%ensfl ; name error
|
||||
trne %fval ; if still valid
|
||||
.call joberr ; try to punt the user
|
||||
nop ; oh well
|
||||
ret ; return lose
|
||||
endif. ; bye bye
|
||||
|
||||
rrovfl: .lose ; here if we overflow rrecs
|
||||
|
||||
;; routine to dump string in A down AOBJN pointer in TT
|
||||
outstr: saveac [a,b,t] ; dont' trash acs we use
|
||||
move t,a ; find out length
|
||||
call strlen
|
||||
movem t,(tt) ; store length
|
||||
addm t,rrecnt ; here too
|
||||
aos rrecnt ; (count the length word in user buffer)
|
||||
aobjp tt,rrovfl
|
||||
do. ; copy all bytes
|
||||
ildb b,a
|
||||
movem b,(tt)
|
||||
aobjp tt,rrovfl ; crap out if overflow buffer
|
||||
sojg t,top.
|
||||
enddo. ; if we make it here we won
|
||||
ret
|
||||
|
||||
;; here for name to address lookups
|
||||
qt.a: move a,[440700,,qname]
|
||||
call netwrk"hstlook ; find the name
|
||||
ifskp. ; found it
|
||||
move b,a ; get SITE entry
|
||||
call netwrk"hstsrc
|
||||
anskp. ; never happens, we hope
|
||||
move e,netwrk"stradr(d) ; get ADDRESS table entry
|
||||
move a,qclass ; figure out what kind of address we want
|
||||
came a,[ascii "CH"] ; chaos?
|
||||
skipa a,[tlne b,(netwrk"ne%unt)] ; no, want Unternet bit OFF
|
||||
move a,[tlnn b,(netwrk"ne%unt)] ; yes, want Unternet bit ON
|
||||
move tt,[-lrrecs,,rrecs]
|
||||
do. ; loop over all addresses
|
||||
move b,hsttab+netwrk"addadr(e)
|
||||
xct a ; is this address a winner?
|
||||
ifskp. ; yup
|
||||
movem b,(tt) ; store it for client
|
||||
aos rrecnt ; count it
|
||||
aobjp tt,endlp. ; exit loop if ran out of buffer
|
||||
endif.
|
||||
hrrz e,hsttab+netwrk"adrcdr(e)
|
||||
jumpn e,top. ; CDR to next address
|
||||
enddo.
|
||||
skipn rrecnt ; now, did we get anything?
|
||||
anskp. ; damned well better have
|
||||
retskp ; yeah, we won
|
||||
else. ; lost somewhere along the line
|
||||
movsi tt,%ensfl ; make it NAME ERROR
|
||||
trne %fval ; (this isn't correct if just aren't any
|
||||
.call joberr ; addresses for this class and name, but
|
||||
nop ; nobody cares right now anyway...)
|
||||
ret
|
||||
endif.
|
||||
|
||||
;; here to look up HINFO data
|
||||
qt.hin: move a,[440700,,qname]
|
||||
call netwrk"hstlook
|
||||
ifskp.
|
||||
move b,a
|
||||
call netwrk"hstsrc
|
||||
anskp. ; machine and opsys info
|
||||
move e,netwrk"stlsys(d)
|
||||
move tt,[-lrrecs,,rrecs]
|
||||
ifxn. e,<0,,-1>
|
||||
move a,[440700,,hsttab]
|
||||
addi a,(e) ; dump machine type if exists
|
||||
call outstr
|
||||
else. ; no string present
|
||||
setzm (tt) ; fake zero length string
|
||||
aos rrecnt
|
||||
aobjp tt,rrovfl
|
||||
endif.
|
||||
movss e ; now handle opsys
|
||||
ifxn. e,<0,,-1> ; same drill
|
||||
move a,[440700,,hsttab]
|
||||
addi a,(e)
|
||||
call outstr
|
||||
else.
|
||||
setzm (tt)
|
||||
aos rrecnt
|
||||
aobjp tt,rrovfl
|
||||
endif.
|
||||
retskp ; if we made it here we won
|
||||
else.
|
||||
movsi tt,%ensfl ; name error, i guess
|
||||
trne %fval
|
||||
.call joberr
|
||||
nop
|
||||
ret
|
||||
endif.
|
||||
|
||||
;; count length of an asciz string in T, return length in T
|
||||
strlen: saveac [a,b]
|
||||
move a,t
|
||||
setz t,
|
||||
do.
|
||||
ildb b,a
|
||||
skipe b
|
||||
aoja t,top.
|
||||
enddo.
|
||||
ret
|
||||
|
||||
;; compare two strings, skip iff eq. smashes nothing
|
||||
strcmp: saveac [a,b,c,d]
|
||||
do.
|
||||
ildb c,a
|
||||
ildb d,b
|
||||
andi c,137
|
||||
andi d,137
|
||||
came c,d
|
||||
ret
|
||||
jumpn c,top.
|
||||
enddo.
|
||||
retskp
|
||||
|
||||
;; parse a number from string in A. radix in C. value returned in T.
|
||||
;; TT contains character that caused us to stop.
|
||||
nin: setz t,
|
||||
do.
|
||||
ildb tt,a
|
||||
cail tt,"0
|
||||
caile tt,"9
|
||||
ret
|
||||
imul t,c
|
||||
addi t,-"0(tt)
|
||||
loop.
|
||||
enddo.
|
||||
|
||||
;; address parsers. value returned in B. skips iff ok.
|
||||
|
||||
;; read a chaosnet address number (just a single octal number)
|
||||
nin.ch: move a,[440700,,qname] ; where the string is
|
||||
movei c,8. ; octal
|
||||
call nin ; read it
|
||||
jumpn tt,r ; better have ended with null
|
||||
jumple t,r ; and be a reasonable number
|
||||
cail t,177777
|
||||
ret
|
||||
hrli t,40700 ; add Unternet constant
|
||||
move b,t ; save result
|
||||
retskp ; won
|
||||
|
||||
;; read an internet address number in reverse format (yum!)
|
||||
nin.in: move a,[440700,,qname] ; where the string lives
|
||||
setz b, ; no address yet
|
||||
movei c,10. ; decimal
|
||||
irp foo,,[".,".,".,0]
|
||||
call nin
|
||||
jumpl t,r
|
||||
caig t,377
|
||||
caie tt,foo
|
||||
ret
|
||||
dpb t,[<<.irpcnt_15.>+001000>,,b]
|
||||
termin
|
||||
retskp
|
||||
|
||||
tsint:
|
||||
loc 42
|
||||
-ltsint,,tsint
|
||||
loc tsint
|
||||
intacs,,p
|
||||
0 ? 1_boj ? %piioc ? 1_boj ? bojint
|
||||
ltsint==:.-tsint
|
||||
|
||||
intacs==:400002+t_6 ; 3 things plus T and TT
|
||||
|
||||
;;; .CALL DISMIS: Dismiss an interrupt
|
||||
dismis: setz
|
||||
sixbit /dismis/
|
||||
movsi intacs
|
||||
setz p
|
||||
|
||||
|
||||
;;; Handle interrupt on the BOJ channel
|
||||
bojint: report "BOJ interrupt"
|
||||
trz %fiot\%fsiot\%frwo\%fval
|
||||
setz y, ; (see OUTPUT routine)
|
||||
move tt,[-largs,,args]
|
||||
.call jobcal
|
||||
jrst disint
|
||||
tlne t,%jgcls ; .close ?
|
||||
seto t, ; yeah, fake the offset
|
||||
call @caltbl(t) ; dispatch to handler
|
||||
disint: .call dismis ; back to MP level
|
||||
.lose %lssys
|
||||
jrst disint
|
||||
|
||||
close ; .close (fake offset -1)
|
||||
caltbl: offset -.
|
||||
%joopn:: caldie ; .open (?)
|
||||
%joiot:: iot ; .iot
|
||||
%jolnk:: caldie ; mlink (?)
|
||||
%jorst:: calwtd ; .reset
|
||||
%jorch:: caldie ; .rchst
|
||||
%joacc:: calwtd ; .access
|
||||
%jornm:: caldie ; .fdele (delete or rename) (?)
|
||||
%jorwo:: renmwo ; .fdele (renmwo)
|
||||
%jocal:: caldie ; .call
|
||||
offset 0
|
||||
|
||||
caldie: .lose
|
||||
|
||||
close: report "CLOSE"
|
||||
tro %fclos ; set a flag
|
||||
ret ; and dismis
|
||||
|
||||
iot: report "IOT"
|
||||
tlnn t,%jgsio
|
||||
troa %fiot
|
||||
tro %fsiot
|
||||
ret
|
||||
|
||||
renmwo: report "RENMWO"
|
||||
tro %frwo
|
||||
ret
|
||||
|
||||
calwtd: report "%EBDDV"
|
||||
movsi tt,%ebddv
|
||||
.call joberr
|
||||
nop
|
||||
ret
|
||||
|
||||
;;; .CALL JOBCAL: Get system call and arguments
|
||||
;;; TT (arg): aobjn to args area
|
||||
;;; T (val): opcode
|
||||
jobcal: setz
|
||||
sixbit /jobcal/
|
||||
movei boj
|
||||
move tt
|
||||
setzm t
|
||||
|
||||
;;; .CALL JOBRET: Return values from system call
|
||||
;;; TT (arg): aobjn to values
|
||||
jobret: setz
|
||||
sixbit /jobret/
|
||||
movei boj
|
||||
movei 1
|
||||
setz tt
|
||||
|
||||
;;; .CALL JOBRT0: Return no values from system call
|
||||
jobrt0: setz
|
||||
sixbit /jobret/
|
||||
movei boj
|
||||
setzi 1
|
||||
|
||||
;;; .CALL JOBERR: Return error from system call
|
||||
;;; TT (arg): <error code>,,0
|
||||
joberr: setz
|
||||
sixbit /jobret/
|
||||
movei boj
|
||||
setz tt
|
||||
|
||||
;;; .CALL JOBIOC: Cause IOC error
|
||||
;;; T (arg): error code
|
||||
jobioc: setz
|
||||
sixbit /jobioc/
|
||||
movei boj
|
||||
setz t
|
||||
|
||||
constants
|
||||
variables
|
||||
|
||||
oargs:: ;; Arguments provided to initial OPEN, MLINK, DELETE or RENAME
|
||||
oxfn1: 0 ; OX... Second set of filenames
|
||||
ofn1: 0 ; O... First set of filenames
|
||||
ofn2: 0
|
||||
odir: 0
|
||||
odev: 0
|
||||
oxfn2::
|
||||
omode: 0 ; 18 bit open mode in right half
|
||||
oxdir: 0
|
||||
optr: 0 ; String arguments if given.
|
||||
oxptr: 0
|
||||
loargs==:.-oargs
|
||||
|
||||
args:: ;; Arguments provided to subsequent calls
|
||||
iotcnt:: ; IOT byte count
|
||||
calnam: 0 ; .CALL sixbit name
|
||||
calbts: 0 ; .CALL control bits
|
||||
callen: 0 ; .CALL argument count
|
||||
arg1: 0 ; .CALL arg 1
|
||||
arg2: 0 ; .CALL arg 2
|
||||
arg3: 0 ; .CALL arg 3
|
||||
arg4: 0 ; .CALL arg 4
|
||||
arg5: 0 ; .CALL arg 5
|
||||
xptr:: ; RENMWO string argument
|
||||
arg6: 0 ; .CALL arg 6
|
||||
largs==:.-args
|
||||
|
||||
ffpage==:<.+1777>_-12 ; First free page
|
||||
|
||||
clntpg==:ffpage ; where to map user pages
|
||||
|
||||
hstpag==:ffpage+2
|
||||
hsttab=:hstpag_12 ; where to map host table
|
||||
|
||||
end go
|
||||
2225
src/sysnet/netrts.355
Normal file
2225
src/sysnet/netrts.355
Normal file
File diff suppressed because it is too large
Load Diff
489
src/sysnet/netsnd.62
Normal file
489
src/sysnet/netsnd.62
Normal file
@@ -0,0 +1,489 @@
|
||||
;;; -*- Mode: MIDAS; Fonts: MEDFNT -*-
|
||||
|
||||
NTSVER==.IFNM2
|
||||
|
||||
comment|
|
||||
NETSND - Send current msg (L) to all recipients for the host in N,
|
||||
using XRCP whenever possible. Assumes already "connected".
|
||||
|
||||
|
|
||||
|
||||
; LIMRQS controls the # times a rcpt is allowed to temporarily fail.
|
||||
; These are usually due to asshole hosts that blow out on control
|
||||
; characters or long lines in the message text. Generally due to
|
||||
; directory full on the local host, so try for a long time.
|
||||
|
||||
LIMRQS: CAIG A,30. ; LIMRQS for remote hosts.
|
||||
CAIG A,200. ; LIMRQS for local host. (200 = about 3 days)
|
||||
|
||||
|
||||
NSMFLN: 2000. ; If message more chars than this, use MLFL
|
||||
|
||||
BVAR ; NETSND variables
|
||||
NSCTQ: 0 ; On return, # of RCP's (must queue)
|
||||
NSCTF: 0 ; On return, # of RCPF's (failed, with A$RRMG's)
|
||||
NSCTS: 0 ; On return, # of RSNT's (sent, successful)
|
||||
|
||||
NSSNT1: 0 ; -1 if "1st part done" for R or T mode.
|
||||
NSRHDR: 0 ; SPT to current header being used, 0 if none.
|
||||
NSRLST: 0 ; LP to list of VLN's indicating RCPTs done each pass.
|
||||
NSRRST: 0 ; LP to RCP to restart loop at with new header.
|
||||
EVAR
|
||||
|
||||
SUBTTL NETSND
|
||||
|
||||
; NETSND - (assumes ICP already performed!)
|
||||
; Sends message to all recipients for a specific host, taking
|
||||
; advantage of XRCP whenever possible.
|
||||
; L - Current LSE holding message.
|
||||
; N - Site # being hacked.
|
||||
; Returns with the following variables set:
|
||||
; NSCTS - # of rcpts sent to (A$RCP changed to A$RSNT)
|
||||
; NSCTF - # of rcpts failed (A$RCP changed to A$RCPF and failure
|
||||
; message attached in A$RRMG.)
|
||||
; NSCTQ - # of rcpts failed temporarily (unchanged). This will
|
||||
; not include all rcpts if a non-skip return is made.
|
||||
; Returns .+1 if host died or inactive, implying an abort.
|
||||
; Returns .+2 if host still connected as far as NETSND knows.
|
||||
|
||||
NETSND: PUSHAE P,[A,B,C,D,E,L]
|
||||
; Initialize NETSND vars.
|
||||
SETZM NSCTQ ; Clear # of RCP's left after pass (to queue).
|
||||
SETZM NSCTF ; Clear # of RCPF's
|
||||
SETZM NSCTS ; Clear # of RSNT's
|
||||
SETZM NSSNT1 ; No "1st part done".
|
||||
SETZM NSRHDR ; No current header.
|
||||
SETZM NSRLST ; No list of RCP's done this pass.
|
||||
SETZM NSRRST ; No restart-RCP
|
||||
SETZM XRSQS ; Clear XRSQ scheme-to-use
|
||||
MOVE A,$LLLST(L) ; First see if want to as for XRSQ or not.
|
||||
CALL NSRFND ; Find a rcpt starting from LP in A.
|
||||
JRST [ CSTAT (,("... no rcpts for host!"))
|
||||
JRST NTSN95] ; No rcpts for this host?
|
||||
MOVE B,A ; Save 1st rcpt found
|
||||
JUMPE N,NTSN05 ; Needn't look for next if sending locally.
|
||||
HRRZ A,LISTAR(A) ; Get CDR
|
||||
CALL NSRFND ; and find next rcpt for this host.
|
||||
JRST NTSN05 ; No more? Just one rcpt, so don't hack XRSQ.
|
||||
;; More than one rcpt for host, so it's worthwhile to hack XRSQ.
|
||||
SKIPN XRSQQ ; Already tried asking for pref?
|
||||
JRST [ PUSH P,B
|
||||
CALL NTXRSQ ; Nope, so go ask.
|
||||
NOP ; Net failure, but quit farther on.
|
||||
POP P,B
|
||||
JRST .+1]
|
||||
MOVE A,XRSQRS ; Get scheme that's been negotiated,
|
||||
MOVEM A,XRSQS ; and select that for hacking.
|
||||
;; OK, we've got a scheme and there's someone to send to.
|
||||
;; Do any low-level per-transaction initialization that is needed.
|
||||
NTSN05: JUMPE N,NTSN06 ; Not needed if really sending locally.
|
||||
TLNE F,%QULOS ; Nor if flushing this message
|
||||
JRST NTSN06
|
||||
;; Now setup for entry into loop, so that "next" rcpt is
|
||||
;; first one. Still have LP in B to 1st rcpt...
|
||||
NTSN06: MOVEI E,(B) ; Set up E and skip over CDR-get,
|
||||
JRST NTSN12 ; for a little efficiency.
|
||||
|
||||
;; Main loop of NETSND.
|
||||
NTSN10: HRRZ E,LISTAR(E) ; Get CDR of rcpt just done,
|
||||
NTSN11: MOVEI A,(E) ; and search from that point
|
||||
CALL NSRFND ; to get a rcpt for this host.
|
||||
JRST NTSN50 ; No more this pass? Cleanup time...
|
||||
MOVEI E,(A) ; Save LP to the A$RCP.
|
||||
NTSN12: MOVE A,LISTAR(E)+1 ; Get LP to rcpt's list.
|
||||
TLNE F,%QULOS ; If we are flushing this message
|
||||
JRST [ MAKELN B,[0 ? %LTSTR,,[LITSTR [Host appears to be permanently down or not accepting mail.]]]
|
||||
JRST NTSN28 ]
|
||||
;.ERR Move %QULOS feature elsewhere someday
|
||||
CALL SETMSM ; Set mail/send modes. Hope no SEND'ing!
|
||||
JUMPE N,[MOVE A,E ; If sending LOCALLY, then use
|
||||
CALL SNDMSG ; this routine, and on return
|
||||
JUMPE A,NTSN22 ; dispatch to right thing for win
|
||||
JRST NTSN25] ; or lose.
|
||||
SKIPE XRSQS
|
||||
JRST NTSN30 ; Go do either T or R mode.
|
||||
|
||||
;; Default scheme, no XRCP hacking.
|
||||
NTSN20: CALL NTMINI ; Initialize, mostly for SMTP.
|
||||
JRST NTSN25 ; Ugh! Abort this msg...
|
||||
MOVEI B,(C) ; Restore B
|
||||
MOVE A,LISTAR(E)+1 ; LP to rcpt list.
|
||||
CALL NTSBEG ; Give command & name to remote host.
|
||||
JRST NTSN25 ; Error of some kind, go investigate.
|
||||
MOVE A,LISTAR(E)+1 ; LP to rcpt list.
|
||||
CALL NTSMID ; Send header & text of message
|
||||
JRST NTSN25 ; Error of some kind, go investigate.
|
||||
CALL NTMEND ; Now terminate it and verify...
|
||||
JRST NTSN25 ; Foo.
|
||||
NTSN22: AOS NSCTS ; Win, bump count of sents.
|
||||
SKIPA B,[A$RSNT] ; Default mode success,
|
||||
NTSN24: MOVEI B,A$RCPF
|
||||
DPB B,[$LAFLD,,LISTAR(E)] ; say sent to this rcpt!
|
||||
TLO F,%MSGMD
|
||||
JRST NTSN10 ; Return to loop to get another.
|
||||
|
||||
NTSN25: CAIE A,MR$PEH
|
||||
CAIN A,MR$TEH ; Error for host?
|
||||
JRST NTSN85 ; If so, abort.
|
||||
CAIE A,MR$TER ; Temp err for rcpt?
|
||||
JRST NTSN27
|
||||
NTSN26: FINDA A,[A$RFCT,,[LISTAR(E)+1]] ; See if rcpt has a failure count.
|
||||
JRST [ MAKELN A,[A$RFCT,,[LISTAR(E)+1] ; No, make one.
|
||||
%LTVAL,,0]
|
||||
HRRM A,LISTAR(E)+1
|
||||
JRST .+1]
|
||||
AOS A,LISTAR(A)+1
|
||||
TLO F,%MSGMD ; Message LSE munged.
|
||||
SKIPN N ; Local host?
|
||||
SKIPA B,LIMRQS+1 ; Find ins for max temp failure count check.
|
||||
MOVE B,LIMRQS
|
||||
XCT B ; # temp errors greater than limit allowed?
|
||||
JRST [ AOS NSCTQ ; Nope, just queue. Bump cnt of # queued
|
||||
JRST NTSN10] ; and go back to main loop.
|
||||
CSTAT (,("...Giving up."))
|
||||
MAKELN B,[0
|
||||
%LTSAO,,[[OUTCAL(,("I gave up on sending this after "),D(A),(| "temporary" errors.|))]] ]
|
||||
JRST NTSN28 ; Permanent error...
|
||||
|
||||
NTSN27: CAIE A,MR$PER ; If this was not a permanent error
|
||||
JSR AUTPSY ; strange type error!
|
||||
NTSN28: JUMPE B,NTSN29 ; Error-msg SLN may already be composed.
|
||||
MOVEI A,A$RRMG ; Else set up for it.
|
||||
DPB A,[$LAFLD,,LISTAR(B)]
|
||||
MOVE A,LISTAR(E)+1
|
||||
HRRM A,LISTAR(B)
|
||||
MOVEM B,LISTAR(E)+1 ; Cons onto rcpt's list.
|
||||
NTSN29: AOS NSCTF ; Bump count of failures.
|
||||
JRST NTSN24 ; Go mark rcpt failed.
|
||||
|
||||
;; Here either T or R mode. Determine whether rcpt can be
|
||||
;; "merged" with previous rcpt.
|
||||
NTSN30: SKIPE SORMSW ; Check mail/send switch...
|
||||
JRST [ SKIPN NSSNT1 ; Ugh!! Is this 1st rcpt this pass?
|
||||
JRST NTSN20 ; Yes, can just use regular default scheme!
|
||||
SKIPN NSRRST ; Foo, already committed, do it another pass.
|
||||
MOVEM E,NSRRST ; Start with this one if none yet targetted.
|
||||
JRST NTSN10]
|
||||
MOVE A,LISTAR(E)+1
|
||||
CALL GNTHDR ; Get net header for rcpt
|
||||
MOVE A,LISTAR(A)+1 ; Get SPT for the header.
|
||||
CAME A,NSRHDR ; Same as current header?
|
||||
JRST [ SKIPN NSRHDR ; No. Is there actually any current header?
|
||||
JRST .+1 ; No current header, so set to this one.
|
||||
SKIPN NSRRST ; Sigh, headers don't match, can't send.
|
||||
MOVEM E,NSRRST ; Set "rcpt to restart from" for next pass.
|
||||
JRST NTSN10] ; Back to get another rcpt...
|
||||
MOVEM A,NSRHDR ; Win, set val of current header (see .+1 ref above)
|
||||
|
||||
;; Okay, have verified that entire msg for this rcpt is
|
||||
;; identical with that of previous (if any), and can use XRCP.
|
||||
SKIPG XRSQS ; Skip if T mode...
|
||||
JRST NTSN40 ; R mode, handle differently.
|
||||
SKIPE NSSNT1 ; T mode. Already sent text?
|
||||
JRST NTSN35 ; Yes, go send rcpt name.
|
||||
CALL NTMINI ; No, initialize as needed
|
||||
JRST NTSN25 ; Ugh, abort!
|
||||
SETZ A,
|
||||
CALL NTSBEG ; Begin msg with null rcpt.
|
||||
JRST NTSN25 ; Assume any err means abort.
|
||||
SETZ A,
|
||||
CALL NTSMID ; Send header and text of message!
|
||||
JRST NTSN25 ; Assume any error means host died.
|
||||
CALL NTMEND
|
||||
JRST NTSN25
|
||||
SETOM NSSNT1 ; Won, indicate text sent.
|
||||
;; Here's where the rcpt name is actually sent...
|
||||
NTSN35: MOVE A,LISTAR(E)+1
|
||||
CALL NTSXRC ; Send XRCP <name>.
|
||||
JRST NTSN25 ; Error, handle just as for default case.
|
||||
JRST NTSN22 ; Win, also handle just as for default.
|
||||
|
||||
;; Rcpts-first mode!
|
||||
NTSN40: SKIPN NSSNT1 ; 1st part stuff done yet?
|
||||
JRST [ CALL NTMINI ; Nope, initialize.
|
||||
JRST NTSN25 ; Ugh, error means abort.
|
||||
JRST .+1]
|
||||
MOVE A,LISTAR(E)+1
|
||||
CALL NTSXRC ; Send XRCP <name>.
|
||||
JRST NTSN25 ; Ugh, handle error.
|
||||
SETOM NSSNT1 ; Indicate a rcpt was specified,
|
||||
MAKELN A,[0,,[NSRLST] ; and cons up a VLN to remember this rcpt
|
||||
%LTVAL,,[E]] ; by means of its LP.
|
||||
MOVEM A,NSRLST ; Gets consed onto front.
|
||||
JRST NTSN22 ; Then set A$RCP to A$RSNT and go get another!
|
||||
|
||||
;; Control comes here when main loop runs out of rcpts.
|
||||
;; This doesn't necessarily mean that all rcpts for this host
|
||||
;; are gone; rather, it only means that one pass of XRCP's
|
||||
;; has finished.
|
||||
NTSN50: SKIPL XRSQS ; If R mode, lots of cleanup to do.
|
||||
JRST NTSN60 ; Nope, skip it.
|
||||
|
||||
SKIPN NSSNT1 ; Were any XRCP's successfully spec'd?
|
||||
JRST NTSN60 ; Nope, needn't send text.
|
||||
SETZ A,
|
||||
CALL NTSBEG ; Initiate message with null rcpt.
|
||||
JRST NTSN55 ; Arrrrgh!!!
|
||||
SETZ A,
|
||||
CALL NTSMID ; Must send it! Output header, body, etc.
|
||||
JRST NTSN55
|
||||
CALL NTMEND ; Terminate message text.
|
||||
CAIA ; Oh shit. Go handle in detail.
|
||||
JRST NTSN60 ; Success!! Go tidy up.
|
||||
|
||||
NTSN55: CAIE A,MR$PEH ; Host type error?
|
||||
CAIN A,MR$TEH
|
||||
JRST NTSN85 ; Yeah, go abort stuff.
|
||||
CAIN A,MR$TER ; Temp err for "rcpt"?
|
||||
JRST NTSN85 ; Yeah, also assume abort. (easy way out)
|
||||
CAIE A,MR$PER ; PERM err????? Shouldn't, but...
|
||||
JSR AUTPSY ; (unknown result code)
|
||||
|
||||
; Perm fail: set all RCP's on NSRLST to RCPF's.
|
||||
SKIPN A,NSRLST
|
||||
JRST NTSN60 ; None to flush?? Oh well.
|
||||
MOVE C,B ; Put error message SLP in C as arg.
|
||||
MOVEI B,A$RRMG
|
||||
DPB B,[$LAFLD,,LISTAR(C)] ; Set up with proper attrib.
|
||||
MOVEI B,[MOVE A,LISTAR(A)+1
|
||||
LDB C,[$LAFLD,,LISTAR(A)]
|
||||
CAIE C,A$RSNT
|
||||
PJRST POPJ1
|
||||
MOVEI C,A$RCPF
|
||||
DPB C,[$LAFLD,,LISTAR(A)]
|
||||
SOS NSCTS
|
||||
LNCOPY B,[0 ? B] ; Get a SLN for err msg.
|
||||
MOVE C,LISTAR(A)+1 ; Cons onto
|
||||
HRRM C,LISTAR(B) ; start of
|
||||
MOVEM B,LISTAR(A)+1 ; rcpt's list.
|
||||
TLO F,%MSGMD
|
||||
PJRST POPJ1]
|
||||
CALL MAPC
|
||||
JSR AUTPSY
|
||||
|
||||
NTSN60: SKIPE NSRLST
|
||||
LNDEL NSRLST ; Delete everything in the temporary list...
|
||||
SKIPN E,NSRRST ; Any need to restart a pass?
|
||||
JRST NTSN95 ; Take win return.
|
||||
SETZM NSRHDR ; New pass needed, LP to 1st is now in E.
|
||||
SETZM NSSNT1 ; Clear necessary stuff.
|
||||
SETZM NSRRST ; e.g. the restart indicator!
|
||||
JRST NTSN11 ; Re-enter loop at right place.
|
||||
|
||||
; Handle abort caused by host failure.
|
||||
NTSN80:
|
||||
IFN 0,[
|
||||
;; I tried putting Chaos SENDs in the "init" phase one day...
|
||||
SKIPN SORMSW ; Sends require some cleanup.
|
||||
JRST NTSN85
|
||||
SKIPE XRSQS ; Treat XRCPd sends like mail.
|
||||
JRST NTSN85
|
||||
;; Here to abort a failing send.
|
||||
MOVE C,B ; Put error message SLP in C as arg.
|
||||
MOVEI B,A$RRMG ; Set up with proper attrib.
|
||||
DPB B,[$LAFLD,,LISTAR(C)]
|
||||
MOVE A,LISTAR(A)+1 ; LP to rcpt list.
|
||||
MOVEI C,A$RCPF ; Say we are a failure.
|
||||
DPB C,[$LAFLD,,LISTAR(A)]
|
||||
LNCOPY B,[0 ? B] ; Get a SLN for err msg.
|
||||
MOVE C,LISTAR(A)+1 ; Cons onto
|
||||
HRRM C,LISTAR(B) ; start of rcpt's list.
|
||||
MOVEM B,LISTAR(A)+1
|
||||
AOS NSCTF ; Count a failure.
|
||||
TLO F,%MSGMD
|
||||
POPAE P,[L,E,D,C,B,A]
|
||||
JRST POPJ1
|
||||
];IFN 0
|
||||
|
||||
NTSN85: SKIPGE XRSQS ; Only R mode requires any backing up,
|
||||
SKIPN NSRLST ; and only when a "sent" list exists.
|
||||
JRST NTSN99 ; Others just take non-skip return.
|
||||
|
||||
;; Change all A$RSNT's on temp list to A$RCP's again.
|
||||
;; Don't bother trying to hack rcpt failure counts now. Maybe someday
|
||||
;; the failure stuff will be modularized enough to make it plausible.
|
||||
MOVE A,NSRLST
|
||||
MOVEI B,[MOVE A,LISTAR(A)+1
|
||||
LDB B,[$LAFLD,,LISTAR(A)]
|
||||
CAIE B,A$RSNT
|
||||
PJRST POPJ1
|
||||
SOS NSCTS ; Bump down cnt of # sent.
|
||||
MOVEI B,A$RCP
|
||||
DPB B,[$LAFLD,,LISTAR(A)]
|
||||
PJRST POPJ1]
|
||||
CALL MAPC
|
||||
JSR AUTPSY
|
||||
JRST NTSN99 ; Abort, so take non-skip return.
|
||||
|
||||
NTSN95: AOSA -6(P)
|
||||
NTSN99: AOS NSCTQ ; Failure return always wants queueing.
|
||||
POPAE P,[L,E,D,C,B,A]
|
||||
RET
|
||||
|
||||
SUBTTL NSRFND, NSRNAM, GNTHDR
|
||||
|
||||
; NSRFND - Find a valid recipient.
|
||||
; A - LP to start searching from.
|
||||
; N - host # that rcpt must be for.
|
||||
; Returns .+1 if none found.
|
||||
; Returns .+2
|
||||
; A - LP to A$RCP that fits this host.
|
||||
|
||||
NSRFND: PUSH P,B
|
||||
NSRFN0: FINDA A,[A$RCP,,[A]] ; Hunt for an active rcpt
|
||||
PJRST POPBJ
|
||||
FINDA B,[A$RPSN,,[LISTAR(A)+1]] ; Is rcpt a pseudo?
|
||||
CAIA
|
||||
JRST NSRFN5 ; Yeah, get next.
|
||||
FINDA B,[A$RHST,,[LISTAR(A)+1]] ; Get host...
|
||||
TDZA B,B
|
||||
MOVE B,LISTAR(B)+1 ; Get host #
|
||||
CAMN B,OWNHS2
|
||||
SETZ B,
|
||||
CAMN B,OWNHST ; Canonicalize self.
|
||||
SETZ B,
|
||||
CAMN B,N ; Right host?
|
||||
PJRST POPBJ1 ; Yep, win return.
|
||||
NSRFN5: HRRZ A,LISTAR(A) ; Sigh, try another.
|
||||
JUMPN A,NSRFN0
|
||||
PJRST POPBJ
|
||||
|
||||
; NSRNAM - Get name for rcpt.
|
||||
; A - LP to rcpt list.
|
||||
; Returns
|
||||
; A - SLP to string to use in FTP command.
|
||||
; If sign bit set, SLN should be deleted after using.
|
||||
;
|
||||
NSRNAM: PUSH P,A ; Save LP to rcpt list
|
||||
FINDA A,[A$RTYP,,[A]] ; See if any explicit type spec.
|
||||
JRST NSRNM1 ; Nope, can just use name.
|
||||
SLNEA A,[ASCNT [NAME]] ; Type NAME?
|
||||
JRST [ POP P,A ; Sigh, something hairy. Invoke full routine.
|
||||
MAKELN A,[0 ? %LTSAO,,[[CALL NSRNMO]]]
|
||||
RET]
|
||||
NSRNM1: POP P,A
|
||||
FINDA A,[A$RNAM,,[A]] ; Regular name, get it. No further checking.
|
||||
JSR AUTPSY
|
||||
RET
|
||||
|
||||
; NSRNMO - Outputs structured recipient name on standard output.
|
||||
; A/ LP to rcpt list
|
||||
; Clobbers nothing.
|
||||
|
||||
NSRNMO: PUSH P,B
|
||||
FINDA B,[A$RTYP,,[A]] ; See if any explicit type spec.
|
||||
JRST NSRNM2 ; Nope, can just use name.
|
||||
SLNEA B,[ASCNT [NAME]] ; Type NAME?
|
||||
JRST NSRNM3 ; Sigh, something hairy.
|
||||
NSRNM2: FINDA B,[A$RNAM,,[A]] ; Regular name, get it.
|
||||
JSR AUTPSY
|
||||
OUT(,SL(B))
|
||||
JRST NSRNM9
|
||||
|
||||
NSRNM3: SLNEA B,[ASCNT [*MSG]] ; Type *MSG?
|
||||
CAIA ; No, thank goodness.
|
||||
JRST [PUSHJ P,BBDDFS ; Get filename for *MSG.
|
||||
OUT(,LBRK,6Q(LMFDIR),(";"),6Q(LMFFN1),(" "),6Q(LMFFN2),RBRK)
|
||||
JRST NSRNM9]
|
||||
PUSH P,C ; Basic default is to use structured syntax.
|
||||
FINDA C,[A$RNAM,,[A]]
|
||||
JSR AUTPSY
|
||||
OUT(,LPAR,SL(B),(" "),SL(C),RPAR)
|
||||
POP P,C
|
||||
NSRNM9: POP P,B
|
||||
RET
|
||||
|
||||
|
||||
; GNTHDR - Get SLP to net header to use for rcpt.
|
||||
; A - LP to rcpt's list
|
||||
; Returns
|
||||
; A - SLP to header to use.
|
||||
|
||||
GNTHDR: FINDA A,[A$RHDR,,[A]] ; First try rcpt header...
|
||||
CAIA
|
||||
RET ; Win!
|
||||
MOVE A,N ; No rcpt header, is rcpt at ITS site?
|
||||
CALL NHITS ; See if ITS
|
||||
FINDA A,[A$KHDR,,[$LLLST(L)]] ; No, is there a kludge header?
|
||||
CAIA ; ITS, or no kludge header...
|
||||
RET ; Not ITS, and kludge header exists, use it.
|
||||
FINDA A,[A$MHDR,,[$LLLST(L)]] ;Use the default header
|
||||
JSR AUTPSY
|
||||
RET
|
||||
|
||||
SUBTTL NTSBEG, NTSXRC,NTSMID
|
||||
|
||||
; NTSBEG - Setup to begin message transmission.
|
||||
; A - LP to a rcpt list
|
||||
; If zero, assumes no rcpt, just sets up for msg text.
|
||||
; This is used by XRCP scheme hacking.
|
||||
; Returns .+1 if failure (err code in A, string in B)
|
||||
; Returns .+2 if success.
|
||||
|
||||
NTSBEG: STAT (,TAB) ; New line, tab out.
|
||||
PUSH P,C
|
||||
SETZ B, ; Remember if we are Mailing.
|
||||
FINDA C,[A$MTXT,,[$LLLST(L)]]
|
||||
JSR AUTPSY
|
||||
HLRZ C,LISTAR(C)+1
|
||||
CAML C,NSMFLN
|
||||
SETO B, ; For long message, use MLFL.
|
||||
SKIPE SORMSW ; If we are Sending instead of Mailing
|
||||
MOVEI B,1 ; Remember so.
|
||||
;; If just initiating text, skip name hackery.
|
||||
JUMPE A,[ CSTAT (,("TEXT-"),RABR)
|
||||
JRST NTSBG4]
|
||||
CALL NSRNAM ; Now get a SLP to name we'll give to host.
|
||||
MOVE C,A ; Save it.
|
||||
MOVE A,LISTAR(A)+1 ; Make an
|
||||
ADD A,$LSLOC(L) ; ASCNT ptr out of it.
|
||||
CSTAT (,("TO-"),RABR,TC(A))
|
||||
NTSBG4: CALL NTMBEG ; Invoke!!
|
||||
CAIA
|
||||
AOS -1(P) ; Won, skip on return.
|
||||
CAIGE C,
|
||||
LNDEL C, ; Flush temp SLN if need to.
|
||||
POP P,C
|
||||
RET
|
||||
|
||||
; NTSXRC - Specify a recipient via XRCP.
|
||||
; A - LP to rcpt's list
|
||||
; Skips if won, message results in A, B.
|
||||
|
||||
NTSXRC: PUSH P,C
|
||||
CALL NSRNAM ; Now get a SLP to name we'll give to host.
|
||||
MOVE C,A ; Save it.
|
||||
MOVE A,LISTAR(A)+1 ; Make an
|
||||
ADD A,$LSLOC(L) ; ASCNT ptr out of it.
|
||||
STAT (,(" XTO-"),RABR,TC(A)) ; New line, tab out, special to...
|
||||
CALL NTXRCP ; Invoke XRCP...
|
||||
CAIA
|
||||
AOS -1(P) ; Won, skip on return.
|
||||
CAIGE C,
|
||||
LNDEL C, ; Flush temp SLN if need to.
|
||||
POP P,C
|
||||
RET
|
||||
|
||||
|
||||
; NTSMID - Send middle stuff (actual text).
|
||||
; A - LP to rcpt's list. If zero, uses NSRHDR for header.
|
||||
; Returns .+1 if failure (net error type)
|
||||
; Returns .+2 if won.
|
||||
|
||||
NTSMID: JUMPE A,[SKIPN A,NSRHDR
|
||||
JSR AUTPSY
|
||||
JRST NTSMD3]
|
||||
PUSHJ P,GNTHDR ; Get SLP to header in A
|
||||
MOVE A,LISTAR(A)+1
|
||||
NTSMD3: ADD A,$LSLOC(L)
|
||||
PUSHJ P,NTMSND ; Send out over net!
|
||||
RET ; error....
|
||||
FINDA A,[A$MTXT,,[$LLLST(L)]] ; Now send text.
|
||||
JSR AUTPSY
|
||||
MOVE A,LISTAR(A)+1
|
||||
ADD A,$LSLOC(L)
|
||||
PUSHJ P,NTMSND
|
||||
RET ; error....
|
||||
SETZB A,B
|
||||
AOS (P)
|
||||
RET
|
||||
456
src/sysnet/resolv.34
Normal file
456
src/sysnet/resolv.34
Normal file
@@ -0,0 +1,456 @@
|
||||
;;; -*- Mode:MIDAS -*-
|
||||
.AUXIL
|
||||
|
||||
SUBTTL RESOLV - Interface to DOMAIN: device
|
||||
|
||||
;;; Initially, this will be very simple and provide minimal
|
||||
;;; capabilities; as the device and the user software become
|
||||
;;; more sophisticted, this will change. Eventually this
|
||||
;;; library will subsume all of the NETWRK routines except
|
||||
;;; those which are actually involved in hacking network
|
||||
;;; connections and channels.
|
||||
;;;
|
||||
;;; This file contains all the network library code needed by COMSAT!
|
||||
|
||||
.TYO6 .IFNM1
|
||||
.TYO 40
|
||||
.TYO6 .IFNM2
|
||||
PRINTX / included in this assembly.
|
||||
/
|
||||
|
||||
;;; Device OPEN mode bits (not defined in ITS yet):
|
||||
|
||||
%DR==1,,525252
|
||||
%DROUT==1 ;1.1 Output
|
||||
%DRBLK==2 ;1.2 Block
|
||||
%DRIMG==4 ;1.3 Image
|
||||
%DRNRF==:10 ;1.4 Don't update the database
|
||||
%DRLNG==:20 ;1.5 Access long-form data
|
||||
%DRSII==:40 ;1.6 Super-image (packet level)
|
||||
%DRWOV==:100 ;1.7 Force net search and database update
|
||||
%DRAUT==:200 ;1.8 Authoritative data required
|
||||
%DRANY==:400 ;1.9 Illicit data allowed
|
||||
%DRWIZ==:40000 ;2.6 Maintenance
|
||||
%DROJB==:100000 ;2.7 Magical OJB device protocol
|
||||
%DRXXX==:200\400\1000\2000\4000\10000\20000
|
||||
|
||||
;;; Default to not using RENMWO hack on DQ: device.
|
||||
IFNDEF $$DQRN, $$DQRN==0
|
||||
|
||||
;;; Default to allowing all networks we know about
|
||||
IFNDEF $$DQCH, $$DQCH==1
|
||||
IFNDEF $$DQIN, $$DQIN==1
|
||||
|
||||
.BEGIN RESOLV
|
||||
|
||||
IFN $$DQRN,{
|
||||
IFNDEF DQCH,.FATAL DQCH must be defined if $$DQRN turned on
|
||||
} .ELSE {
|
||||
IFNDEF DQCH, DQCH==:16 ;Channel for accessing domain resolver
|
||||
}
|
||||
|
||||
IFE $$DQCH,{
|
||||
PRINTX "Chaosnet code excluded.
|
||||
"}
|
||||
IFE $$DQIN,{
|
||||
PRINTX "Internet code excluded.
|
||||
"}
|
||||
|
||||
SUBTTL Macros and Variables
|
||||
|
||||
DEFINE PUSHER AC,LIST
|
||||
IRP LOC,,[LIST]
|
||||
PUSH AC,LOC
|
||||
TERMIN
|
||||
TERMIN
|
||||
|
||||
DEFINE POPPER AC,LIST
|
||||
IRP LOC,,[LIST]
|
||||
POP AC,LOC
|
||||
TERMIN
|
||||
TERMIN
|
||||
|
||||
DEFINE ZAP LOC,LEN
|
||||
SETZM LOC
|
||||
MOVE T,[LOC,,LOC+1]
|
||||
BLT T,LOC+LEN-1
|
||||
TERMIN
|
||||
|
||||
DEFINE SYSCAL NAME,ARGS
|
||||
.CALL [SETZ ? SIXBIT 'NAME' ? ARGS((SETZ))]
|
||||
TERMIN
|
||||
|
||||
.VECTOR NAMBUF(NAMBLN==50.) ; J. Random Buffer
|
||||
|
||||
IFNDEF NOP,NOP=<JFCL>
|
||||
|
||||
|
||||
SUBTTL Definitions
|
||||
|
||||
NE%UNT==:<1_32.> ; Escape bit indicating non-Internet address
|
||||
NW$BYT==:301400 ; Byte pointer to network number (approx!)
|
||||
NE%STR==:<1_33.> ; Escape bit indicating string-type address
|
||||
|
||||
; Useful HOSTS3 full word network # values
|
||||
NW%CHS==:<NE%UNT+<7_24.>> ; CHAOSNET
|
||||
NW%ARP==:<10._24.> ; ARPANET
|
||||
NW%LCS==:<18._24.> ; MIT-LCS (18.0.0.0)
|
||||
NW%AI==:<20015,,> ; MIT-AI-NET (128.52.0.0)
|
||||
|
||||
|
||||
SUBTTL Routines from NETWRK
|
||||
|
||||
;;; GETNET macro to find host address.
|
||||
|
||||
DEFINE GETNET AC,(ADDR)
|
||||
IFNB [ADDR] MOVE AC,ADDR
|
||||
TLNN AC,(17_32.) ; Check for non-Internet type addrs
|
||||
TLNN AC,(1_31.) ; Internet address, see if class A net
|
||||
TDZA AC,[77,,-1] ; Unternet or class A, zap low 3 octets
|
||||
TLNN AC,(1_30.) ; Class B or C, see which.
|
||||
TRZA AC,177777 ; Class B network, zap low 2 octets
|
||||
TRZ AC,377 ; Class C net, only zap 1 low octet
|
||||
TERMIN
|
||||
|
||||
|
||||
;;; OWNHST - Return own Internet host address in A.
|
||||
;;; A/ network number
|
||||
;;; Non-skip means we are not on that network.
|
||||
|
||||
OWNHST: SETZ B,
|
||||
IFN $$DQIN, TLNN A,(NE%UNT) ? DMOVE A,[0 ? SQUOZE 0,IMPUS3]
|
||||
IFN $$DQCH, CAMN A,[NW%CHS] ? MOVE B,[SQUOZE 0,MYCHAD]
|
||||
SKIPE B
|
||||
.EVAL B,
|
||||
POPJ P,
|
||||
IOR A,B
|
||||
AOS (P)
|
||||
POPJ P,
|
||||
|
||||
;;; CVH3NA - Standardize host address (STDHST)
|
||||
;;; A/ host addr in any format
|
||||
;;; Returns in A: HOSTS3/Internet-style host address number.
|
||||
;;; (Clobbers T. Does not skip.)
|
||||
|
||||
STDHST::
|
||||
CVH3NA: PUSH P,B
|
||||
LDB B,[301400,,A] ; Get high 12 bits of net address
|
||||
CAIGE B,70 ; If less than lowest HOSTS2 value,
|
||||
JUMPN B,CVH3N3 ; it's already HOSTS3 format! (unless zero)
|
||||
CAIL B,1000 ; If any of high 3 bits were set,
|
||||
JRST CVH3N3 ; it must be a HOSTS3 strange-fmt addr.
|
||||
JUMPN B,CVH3N2 ; If not zero, then must assume HOSTS2 fmt.
|
||||
;; Old-format 8-bit Arpanet host number, or HOSTS2 with zero net.
|
||||
CAILE A,377
|
||||
JRST CVH3N6 ; If greater than 8 bits, assume HOSTS2, zero net.
|
||||
LSHC A,-6 ; Put 10 bits spacing between host/imp #s.
|
||||
LSH B,-<2+8.>
|
||||
LSHC A,<2+8.+6>
|
||||
TLO A,(12_24.) ; and add ARPA network number.
|
||||
JRST CVH3N3
|
||||
;; HOSTS2 format number
|
||||
CVH3N2: TRZE B,7 ; Zap low 3 bits to ensure correct comparison
|
||||
JRST CVH3N5 ; If any were set, can't be Chaosnet.
|
||||
CAIN B,7_3 ; Chaos net?
|
||||
JRST [ ANDI A,177777 ; Yes, kill all but bottom 16 bits
|
||||
TLO A,(NW%CHS) ; Add Chaos net #
|
||||
JRST CVH3N3]
|
||||
CVH3N5: CAIN B,12_3 ; Arpa net?
|
||||
CVH3N6: JRST [ LSHC A,-9.
|
||||
ANDI A,177777
|
||||
ROT B,9.
|
||||
DPB B,[201000,,A]
|
||||
TLO A,(12_24.)
|
||||
JRST CVH3N3]
|
||||
CAIN B,22_3 ; LCS net?
|
||||
JRST [ LSHC A,-8.
|
||||
LSH A,-2
|
||||
ANDI A,377
|
||||
LSHC A,-8.
|
||||
TLO A,(22_24.)
|
||||
JRST CVH3N3]
|
||||
;; No match, assume it's already HOSTS3.
|
||||
CVH3N3: POP P,B
|
||||
POPJ P,
|
||||
|
||||
|
||||
|
||||
|
||||
SUBTTL HSTADR - Host name to netaddress
|
||||
|
||||
;;; HSTADR - Resolve host name into address.
|
||||
;;; A/ Bp to (asciz) host name.
|
||||
;;;
|
||||
;;; HSTADN - Resolve host name into address on specific network.
|
||||
;;; A/ Bp to (asciz) host name.
|
||||
;;; B/ Network number (as returned by GETNET).
|
||||
;;;
|
||||
;;; Both return:
|
||||
;;; +1: Error,
|
||||
;;; A/ -1
|
||||
;;; +2: Success,
|
||||
;;; A/ HOSTS3 format address.
|
||||
;;;
|
||||
;;; Maybe should be expanded to return all possible addresses?
|
||||
|
||||
ADDRS::
|
||||
IFN $$DQCH, CH.A: 440700,,[ASCIZ "DQ:HOSTS3;CH;A;"]
|
||||
IFN $$DQIN, IN.A: 440700,,[ASCIZ "DQ:HOSTS3;IN;A;"]
|
||||
NADDRS==.-ADDRS
|
||||
|
||||
HSTADN: PUSHER P,[A,B,C,D] ;Must match HSTADR!!
|
||||
IFE $$DQRN,{ ;Preserve channel unless hairy version
|
||||
SYSCAL IOPUSH,[%CLIMM,,DQCH]
|
||||
NOP
|
||||
}
|
||||
SETZ D, ;Cons up appropriate AOBJN pointer
|
||||
IFN $$DQIN, TLNN B,(NE%UNT) ? HRROI D,<IN.A-ADDRS>
|
||||
IFN $$DQCH, CAMN B,[NW%CHS] ? HRROI D,<CH.A-ADDRS>
|
||||
JUMPE D,HSTA99 ;Punt if bad net type
|
||||
JRST HSTAD1 ;Join HSTADR code.
|
||||
|
||||
HSTADR: PUSHER P,[A,B,C,D]
|
||||
IFE $$DQRN,{ ;Preserve channel unless hairy version
|
||||
SYSCAL IOPUSH,[%CLIMM,,DQCH]
|
||||
NOP
|
||||
}
|
||||
MOVSI D,-NADDRS ;AOBJN ptr to query commands.
|
||||
HSTAD1: ZAP NAMBUF,NAMBLN ;Clear pathname buffer.
|
||||
MOVE A,[440700,,NAMBUF] ;Cons filename
|
||||
MOVE B,ADDRS(D) ;Pick up a command.
|
||||
PUSHJ P,STRCPY ;Stuff it.
|
||||
MOVE B,-3(P) ;Recover QNAME.
|
||||
PUSHJ P,STRCPY ;Stuff it.
|
||||
MOVE A,[440700,,NAMBUF] ;Bp to pathname.
|
||||
PUSHJ P,DOOPEN ;Invoke the resolver
|
||||
JRST [ AOBJN D,HSTAD1 ;Lost, try next class
|
||||
SETOM -3(P) ? JRST HSTA99 ] ;Did all classes, punt
|
||||
SETOM -3(P) ;Paranoia (DQDEV IOT lossage)
|
||||
.IOT DQCH,-3(P) ;Get the address
|
||||
SKIPL -3(P) ;Did we really get anything???
|
||||
AOS -4(P) ;Won, skip return
|
||||
HSTA99:
|
||||
IFE $$DQRN,{
|
||||
.CLOSE DQCH, ;Tidy up
|
||||
SYSCAL IOPOP,[%CLIMM,,DQCH]
|
||||
NOP
|
||||
}
|
||||
POPPER P,[D,C,B,A] ;Fix acs
|
||||
POPJ P,
|
||||
|
||||
|
||||
SUBTTL HSTSRC - Netaddress into host name.
|
||||
|
||||
;;; HSTSRC - Resolve host address into name.
|
||||
;;; A/ Bp to receive host name
|
||||
;;; B/ Net address
|
||||
;;;
|
||||
;;; Skip returns if the host was found, depositing the name down A.
|
||||
;;; Non-skip means unknown netaddress.
|
||||
|
||||
HSTSRC: PUSHER P,[A,B,C,D] ;Save acs (don't change this)
|
||||
IFE $$DQRN,{
|
||||
SYSCAL IOPUSH,[%CLIMM,,DQCH]
|
||||
NOP
|
||||
}
|
||||
ZAP NAMBUF,NAMBLN ;Clear pathname buffer.
|
||||
MOVE A,[440700,,NAMBUF] ;Cons up query string
|
||||
GETNET C,B
|
||||
SETO D, ;Don't know net/class yet
|
||||
IFN $$DQIN, TLNN C,(NE%UNT) ? MOVEI D,0 ;IP = 0
|
||||
IFN $$DQCH, CAMN C,[NW%CHS] ? MOVEI D,1 ;CH = 1
|
||||
JUMPL D,HSTS99 ;Lose if unknown
|
||||
MOVE B,[440700,,[ASCIZ "DQ:HOSTS3;IN;PTR;"]
|
||||
440700,,[ASCIZ "DQ:HOSTS3;CH;PTR;"]](D)
|
||||
PUSHJ P,STRCPY ;Appropriate initial string
|
||||
MOVE B,-2(P) ;Recover host address
|
||||
PUSHJ P,@[ INAPRT ? CHAPRT ](D) ;Write it as appropriate
|
||||
MOVE B,[440700,,[ASCIZ ".IN-ADDR.ARPA"]
|
||||
440700,,[ASCIZ ".CH-ADDR.MIT.EDU"]](D)
|
||||
PUSHJ P,STRCPY ;Appropriate trailing string
|
||||
MOVE A,[440700,,NAMBUF] ;Bp to pathname.
|
||||
PUSHJ P,DOOPEN ;SOPEN or RENMWO as needed
|
||||
JRST HSTS99 ; Host not found - lose!
|
||||
MOVE A,-3(P) ;Recover dest Bp.
|
||||
SETZ B, ;Paranoia, clear string
|
||||
IDPB B,A
|
||||
MOVE A,-3(P) ;BP again
|
||||
.IOT DQCH,B ;Get byte count or IOC error
|
||||
SYSCAL SIOT,[%CLIMM,,DQCH ? A ? B ? %CLERR,,T] ;Snarf string
|
||||
JRST HSTS99 ;Punt
|
||||
SETZ B, ;Ascizify result
|
||||
IDPB B,A
|
||||
MOVE A,-3(P) ;Once more into the breach...
|
||||
ILDB B,A ;Get first byte of result
|
||||
SKIPE B ;Empty?
|
||||
AOS -4(P) ;Won, skip return
|
||||
HSTS99:
|
||||
IFE $$DQRN,{
|
||||
.CLOSE DQCH, ;Tidy up
|
||||
SYSCAL IOPOP,[%CLIMM,,DQCH]
|
||||
NOP
|
||||
}
|
||||
POPPER P,[D,C,B,A] ;Restore acs
|
||||
POPJ P,
|
||||
|
||||
;;; Given in B a network address, print it on Bp in A.
|
||||
|
||||
;;; Chaosnet is easy - just output octal.
|
||||
CHAPRT: MOVE T,B
|
||||
ANDI T,177777 ;Mask out gubbish bits
|
||||
PUSHJ P,OCTDPB
|
||||
POPJ P,
|
||||
|
||||
|
||||
;;; Internet is randomness with dots (ala 44.0.3.10)
|
||||
INAPRT: PUSH P,C
|
||||
MOVEI C,".
|
||||
LDB T,[001000,,B] ;Reverse byte significance.
|
||||
PUSHJ P,DECDPB
|
||||
IDPB C,A
|
||||
LDB T,[101000,,B]
|
||||
PUSHJ P,DECDPB
|
||||
IDPB C,A
|
||||
LDB T,[201000,,B]
|
||||
PUSHJ P,DECDPB
|
||||
IDPB C,A
|
||||
LDB T,[301000,,B]
|
||||
PUSHJ P,DECDPB
|
||||
POP P,C
|
||||
POPJ P,
|
||||
|
||||
|
||||
|
||||
SUBTTL HSTINF - Get machine and opsys type, based on host name
|
||||
|
||||
;;; HSTINF - Resolve name into HINFO data.
|
||||
;;; Args:
|
||||
;;; A/ Bp to host name
|
||||
;;; B/ Bp to receive results
|
||||
;;;
|
||||
;;; Returns:
|
||||
;;; A/ Bp to machine type (asciz)
|
||||
;;; B/ Bp to opsys type (asciz)
|
||||
;;;
|
||||
;;; Result both go in same string, returned pointers are just frills.
|
||||
;;; Skip returns with HINFO data.
|
||||
;;; Non-skip means lost for some reason.
|
||||
|
||||
HINFS:: ;Possible HINFO queries to do
|
||||
CH.INF: 440700,,[ASCIZ "DQ:HOSTS3;CH;HINFO;"]
|
||||
IN.INF: 440700,,[ASCIZ "DQ:HOSTS3;IN;HINFO;"]
|
||||
NHINFS==.-HINFS ;(Try for Chaos first)
|
||||
|
||||
HSTINF: PUSHER P,[A,B,C,D] ;(Order is important)
|
||||
IFE $$DQRN,{
|
||||
SYSCAL IOPUSH,[%CLIMM,,DQCH]
|
||||
NOP
|
||||
}
|
||||
MOVSI D,-NHINFS ;Query commands
|
||||
HSTIN1: ZAP NAMBUF,NAMBLN ;Zero out buffer
|
||||
MOVE A,[440700,,NAMBUF]
|
||||
MOVE B,HINFS(D) ;Snarf a query leader
|
||||
PUSHJ P,STRCPY ;Copy it in
|
||||
MOVE B,-3(P) ;QName
|
||||
PUSHJ P,STRCPY
|
||||
MOVE A,[440700,,NAMBUF] ;Pathname
|
||||
PUSHJ P,DOOPEN ;Get a DQ: server
|
||||
JRST [ AOBJN D,HSTIN1 ? JRST HSTI99 ]
|
||||
MOVE A,-2(P) ;Get destination
|
||||
.IOT DQCH,B ;Get byte count
|
||||
SYSCAL SIOT,[%CLIMM,,DQCH ? A ? B ? %CLERR,,T] ;Snarf first string
|
||||
JRST HSTI99 ;Punt
|
||||
SETZ B, ;Ascizify
|
||||
IDPB B,A
|
||||
MOVEM A,-3(P) ;Save pointer to second string
|
||||
.IOT DQCH,B ;Second byte count
|
||||
SYSCAL SIOT,[%CLIMM,,DQCH ? A ? B ? %CLERR,,T] ;Snarf second string
|
||||
JRST HSTI99 ;Punt
|
||||
SETZ B, ;Ascizify
|
||||
IDPB B,A
|
||||
AOS -4(P) ;Won, skip return
|
||||
HSTI99:
|
||||
IFE $$DQRN,{
|
||||
.CLOSE DQCH, ;Tidy up
|
||||
SYSCAL IOPOP,[%CLIMM,,DQCH] ;Fix up channel
|
||||
NOP
|
||||
}
|
||||
POPPER P,[D,C,A,B] ;Fix up acs (order matters)
|
||||
POPJ P,
|
||||
|
||||
|
||||
SUBTTL DOOPEN - Do the actual invokation of DQ: device
|
||||
|
||||
;;; Opening a DQ: device is expensive. So for them as got lots
|
||||
;;; of courage and no sense, we provide a method for doing multiple
|
||||
;;; queries using a single DQ: server. When DQDEV gets a RENMWO
|
||||
;;; it flushes any data it had pending and jumps back to the SOPEN
|
||||
;;; handler. In order for this to work, DQCH has to be preserved
|
||||
;;; across calls to this library (which is why it must be defined
|
||||
;;; by the user in this case). Callers can release the DQ handler
|
||||
;;; simply by doing a .CLOSE on DQCH when convienient.
|
||||
;;;
|
||||
;;; Well, the above scheme has this bug, in that you keep consing
|
||||
;;; and killing DQDEVs until you get a sucessful query. So now
|
||||
;;; we do a .OPEN to get a good jobdev, then hand it RENMWOs.
|
||||
;;;
|
||||
;;; Call with:
|
||||
;;; A/ Bp to asciz query string
|
||||
;;; Returns:
|
||||
;;; +1: lost, error code in T
|
||||
;;; +2: won, answer now (theoreticly) available by reading from DQCH
|
||||
|
||||
DOOPEN: PUSH P,C ;Don't smash needlessly
|
||||
.STATUS DQCH,C ;Check channel state
|
||||
TRNN C,-1 ;Ignore useless bits
|
||||
.OPEN DQCH,[ (<SIXBIT 'DQ'>+.UII) ? SETZ ? SETZ]
|
||||
JFCL ;Open new server if needed
|
||||
SYSCAL RENMWO,[%CLIMM,,DQCH ? A ? %CLERR,,T]
|
||||
SKIPA ;Look up the data,
|
||||
|
||||
IFN $$DQRN,{ ;Winning multi query version?
|
||||
AOS -1(P) ;Yeah, skip return iff won
|
||||
} .ELSE { ;Losing cretinous version?
|
||||
AOSA -1(P) ;Yeah, skip return iff won,
|
||||
.CLOSE DQCH, ;And braindamage if lost
|
||||
} ;(Yes, I'm calling myself braindead)
|
||||
|
||||
POP P,C ;Fix up acs
|
||||
POPJ P, ;Bye now
|
||||
|
||||
|
||||
SUBTTL Misc.
|
||||
|
||||
;;; Copy B down A, smashing both. Null handled like Twenex SOUT%.
|
||||
STRCPY: ILDB TT,B
|
||||
JUMPE TT,STRCP1
|
||||
IDPB TT,A
|
||||
JRST STRCPY
|
||||
STRCP1: MOVE B,A ;Ascizify but leave pointer
|
||||
IDPB TT,B ;set up for overwriting
|
||||
POPJ P,
|
||||
|
||||
;;; Write number in T down A
|
||||
OCTDPB: SETZ TT,
|
||||
IDIVI T,8.
|
||||
PUSH P,TT ;Push remainder.
|
||||
SKIPE T
|
||||
PUSHJ P,OCTDPB
|
||||
POP P,TT ;Take out in opposite order.
|
||||
ADDI TT,"0 ;Make ASCII.
|
||||
IDPB TT,A
|
||||
POPJ P,
|
||||
|
||||
|
||||
;;; Write number in T down A
|
||||
DECDPB: SETZ TT,
|
||||
IDIVI T,10.
|
||||
PUSH P,TT ;Push remainder.
|
||||
SKIPE T
|
||||
PUSHJ P,DECDPB
|
||||
POP P,TT ;Take out in opposite order.
|
||||
ADDI TT,"0 ;Make ASCII.
|
||||
IDPB TT,A
|
||||
POPJ P,
|
||||
|
||||
.END RESOLV
|
||||
Reference in New Issue
Block a user