comment on

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
}
[download]

# 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"; }
}
[download]

In reply to xmodem protocol by gargle

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


more useful options
	PerlMonks