Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

xmodem protocol

by gargle (Chaplain)
on Aug 16, 2005 at 08:08 UTC ( #484093=snippet: print w/replies, xml ) Need Help??
Description: Here at work we have an old mainframe running an xmodem assembler routine. The mainframe is connected to a modem pool by means of a router. We can access the xmodem mainframe routine by means of the router's ip address.

The following snippets can be used to receive and send a file from or to the mainframe.
# start quick and EXTREMELY dirty xmodem transfert
sub xmodemrecv
{
  print $sock "\x15"; #NAK 
  A000: while(1) {
    SOH: while(1) {
      if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; } #SOH
      last SOH if ( $buf eq "\x01" ) || ( $buf eq "\x04" )
    }
    # leave if last byte received is an EOT
    last A000 if ($buf eq "\x04");
    # last byte received was SOH
    if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; }
    $seq = unpack("c",$buf);
    if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; }
    $cseq = unpack("c",$buf); 
    $mseq = - ($seq & 255) -1; # just for fun we calculate the cmpl se
+q as well
    if (sysread($sock,$buf,128) <= 0) { die "*** died$! ***\n"; }
    $sum = 0;
    for ($i = 0; $i < 128; $i++) {
      $sum += unpack("c",substr($buf,$i,1));
    } 
      $sum = pack("c",($sum & 255)); 
    print "$buf";
    if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; }
    $crc = $buf; 
    if ($crc eq $sum) {
      # packet ok 
      print $sock "\x06"; #ACK
    } else { 
      # packet nok - crc differs
      print $sock "\x15"; #NAK
    }
  }
  print $sock "\x06"; #ACK
}
# start quick and EXTREMELY dirty xmodem transfert
sub xmodemsend
{
  # reading the file to be send
  open (BET ,"filename") || die "*** coudn't open filename ***\n";
  $tosend = <BET>;
  close BET || die "*** couldn't close filename ***\n";
  # wait for #NAK
  WNAK: while(1) {
    if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; } 
    if ($buf eq "\x18") { die "*** CAN received from bs2000 ***\n"; }
    last WNAK if ( $buf eq "\x15" );
    print "$buf"; # print characters bcs after A020 comes TRASEC OK te
+xt
  }
  # start of transfert
  $tel = 1;
  $ptr = 0;
  A000: while(1) {
    $ctel = pack("c",($tel & 255));
    $mtel = pack("c",- ($tel & 255));
    $sum = 0;
    $buf = "";
    for ($i = 0; $i < 128; $i++) {
      $byte = substr($tosend,$i+$ptr,1);
      $buf = "$buf$byte";
      $sum += unpack("c",$byte);
    }
    $sum = pack("c",($sum & 255)); # calculate checksum
    syswrite($sock,"\x01$ctel$mtel$buf$sum",132); # send complete bloc
+k
    print "$buf";
    if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; }
    if ($buf ne "\x06" && $buf ne "\x15" && $buf ne "\x18") { 
      die "*** no ACK, NAK nor CAN recevied after blocktransfert ***\n
+"; 
    }
    if ($buf eq "\x18") { #CAN
      return;
    }
    if ($buf eq "\x06") { #ACK
      # packet ok 
      $tel++;
      $ptr += 128;
    } 
    last A000 if $ptr eq length($tosend);
    if ($ptr > length($tosend)) { die "*** cannot happen :) ***\n"; }
    if ($buf eq "\x15") { #NAK 
      # packet nok - crc differs
    }
  }
  print $sock "\x04"; # EOT
  if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; }
  if ($buf ne "\x06") { die "*** no ACK received after xmodem send ***
+\n"; }
}
Replies are listed 'Best First'.
Re: xmodem protocol
by jfroebe (Parson) on Sep 19, 2005 at 15:35 UTC

    xmodem... gawd, that takes me back... it some ways it was better back then. hmm... I wonder if zmodem could be done over an ssh connection... I can't see why not...

    Jason L. Froebe

    Team Sybase member

    No one has seen what you have seen, and until that happens, we're all going to think that you're nuts. - Jack O'Neil, Stargate SG-1

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: snippet [id://484093]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (2)
As of 2023-02-07 01:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I prefer not to run the latest version of Perl because:







    Results (38 votes). Check out past polls.

    Notices?