TCP/IP

30. RPG で作成する TCP/IP Socket 通信サーバー

Systemi5のユーザーにとっては、開発言語はやはり RPG であるほうがわかりやすいものである。
RPG言語による Socket通信の例が個人サイトにも時々紹介されているがソースのダウンロードが
必要であったり、サービス・プログラム(*SRVPGM)を使ったものなど比較的に大げさな感があった。
ここではもっと手軽に RPG による Socket通信の例として紹介しよう。

Socket 通信 API は旧リリースでは C言語からしか使用できなかったがバインド・ディレクトリー
QSYS/QC2LE さえ指定してやれば、RPG からでも利用することができる。
さらにここではエラーになったときの処理も C言語(C/400) の perror 関数を使ってエラーの内容も
検索する方法を示している。
今回の例は RPG から C関数をどのように利用するのかを示す良い例となっているはずである。
筆者は元々 RPG開発者であったが今ではほとんどは C/400での開発を中心としている。
C言語の理解の基に RPG で C関数を呼び出す例として参考にして頂きたい。

Socket サーバーの処理の内容は前述の「26. TCP/IP Socket通信サーバー」を参照して
もらうこととしてRPG から C関数の呼び出しについて、もう少し解説する。
C言語では、多くの関数が様々な「ライブラリー」(System i5 のライブラリーではない)という形で
EXPORT (公開) されていて、Windows でも拡張子 .lib というものを見かけたことがあるかも
知れない。
C言語のコンパイルは初期の段階ではモジュールにコンパイルされて、その後ライブラリーの関数を
バインドして最終的に実行可能な .exe などに生成される。
この手順はどこかで聞いたことはないだろうか ?
その通り。ILE のコンパイルと同じ原理なのである。
Systemi5 上では C言語も含めて統合化開発環境(ILE)として構成されている。
前置きが長くなったが、つまりは C関数も、いくつかのサービス・プログラム(*SRVPGM) として
例えば SOCKET 通信であれば、QSYS/QSOSRV1 として提供されているのである。

C関数が単なる *SRVPGM であることが理解できれば、RPG からでもこれらの *SRVPGM
バインドしてやればRPG から C関数が使えることは容易に想像できることと思う。
しかし筆者は C言語での開発を頻繁に行っているので SOCKET の *SRVPGM
QSYS/QSOSRV1 であることは簡単に見つけることができたが一般の RPG 開発者であれば、
そうはいかない。
そこで登場するのが IBM が用意してくれたバインド・ディレクトリー QSYS/QC2LE である。
多くのC関数の *SRVPGM は、このバインド・ディレクトリーに登録されているのでRPG は、
どの *SRVPGM が必要か知らなくても QSYS/QC2LE さえ指定しておけば多くの C関数を
簡単に得ることができる。
V5R1M0 からは H仕様書にバインド・ディレクトリーの指定ができるようになったので
ソースに QC2LE を指定しておけば、コンパイルも一層、簡単なものとなる。

長々と書いてしまったがこれらの機能によって RPG のソースは極めて簡単なものになるし、
ILE であることを理解すれば、C関数は *SRVPGM での単なる公開プロシージャーであることも
理解して頂けるものと思う。
また RPG で C関数の利用をマスターすれば C言語からしか呼び出せないと思われていた多くの API も
RPG から簡単に呼び出すことができるようになる。
例としては極めてシンプルなものであるが、初めて C関数を使用する人にとって将来的に
大きく広がりを見せるサンプルなのである。

【 RPG による TCP/IP Socket通信サーバー 】
H DFTNAME(SOCKSVR) DATEDIT(*YMD/) BNDDIR('QC2LE')                  
F***************************************************************** 
F*   SOCKSVR : TEST SOCKET SERVER                                  
F***************************************************************** 
D TRUE            S              4B 0 INZ(0)                       
D FALSE           S              4B 0 INZ(-1)                      
D SOCKFD          S             10I 0 INZ(0)                       
D NEWFD           S             10I 0 INZ(0)                       
D RC              S             10I 0 INZ(0)                       
D AF_INET         S              4B 0 INZ(2)                       
D SOCK_STREAM     S              4B 0 INZ(1)                       
D ON              S             10I 0 INZ(1)                       
D ON_PTR          S               *   INZ(%ADDR(ON))               
D ADDR            S               *   INZ(%ADDR(IADDR))            
D SIZE            S             10I 0 INZ(%SIZE(ADDR))             
D LENOFON         S             10I 0 INZ(%SIZE(ON))               
D PORT            S              4B 0 INZ(400)                     
D SOL_SOCKET      S              4B 0 INZ(-1)                      
D INADDR_ANY      S              4B 0 INZ(0)                       
D SO_REUSEADDR    S              4B 0 INZ(55)                      
D TCP_LEN         S              4B 0 INZ(1492)                   
D BUFF            S             48A                               
D CLIENT          S             10I 0 INZ(10)                     
                                                                  
D SOCKET_ER       S             12A   INZ('SOCKET  ERR')          
D SOCKOPT_ER      S             12A   INZ('SOCKOPT ERR')          
D BIND_ER         S             12A   INZ('BIND    ERR')          
D LISTEN_ER       S             12A   INZ('LISTEN  ERR')          
D ACCEPT_ER       S             12A   INZ('ACCEPT  ERR')          
D RECV_ER         S             12A   INZ('RECV    ERR')          
D SEND_ER         S             12A   INZ('SEND    ERR')          
                                                                  
D IADDR           DS                  QUALIFIED                   
D  SIN_FAMILY                    5I 0                             
D  SIN_PORT                      5U 0                             
D  S_ADDR                       10U 0                             
D  ZERO                          8A                               
                                                                  
D*( SOCKET  のプロトタイプ宣言 )                                  
D SOCKET          PR            10I 0 ExtProc('socket')           
D  ADDR_FAMILY                  10I 0 Value                       
D  TYPE                         10I 0 Value                      
D  PROTOCOL                     10I 0 Value                      
                                                                 
D*( SETSOCKOPT  のプロトタイプ宣言 )                             
D SETSOCKOPT      PR            10I 0 ExtProc('setsockopt')      
D  SOCK_FD                      10I 0 Value                      
D  LEVEL                        10I 0 Value                      
D  OPT_NAME                     10I 0 Value                      
D  OPT_VALUE                      *   Value                      
D  OPT_LENGTH                   10I 0 Value                      
                                                                 
D*( BIND    のプロトタイプ宣言 )                                 
D BIND            PR            10I 0 ExtProc('bind')            
D  SOCK_FD                      10I 0 Value                      
D  SOCK_ADDR                      *   Value                      
D  ADDR_LENGTH                  10I 0 Value                      
                                                                 
D*( LISTEN  のプロトタイプ宣言 )                                 
D LISTEN          PR            10I 0 ExtProc('listen')          
D  SOCK_FD                      10I 0 Value                      
D  BACK_LOG                     10I 0 Value                      
                                                                 
D*( ACCEPT  のプロトタイプ宣言 )                                 
D ACCEPT          PR            10I 0 ExtProc('accept')          
D  SOCK_FD                      10I 0 Value                      
D  SOCK_ADDR                      *   Value                      
D  ADDR_LENGTH                    *   Value                      
                                                                 
D*( RECV    のプロトタイプ宣言 )                                 
D RECV            PR            10I 0 ExtProc('recv')            
D  SOCK_FD                      10I 0 Value                      
D  BUFFER                         *   Value                      
D  BUFF_LENGTH                  10I 0 Value                      
D  FLAGS                         4B 0 Value                      
                                                                 
D*( SEND    のプロトタイプ宣言 )                                 
D SEND            PR            10I 0 ExtProc('send')            
D  SOCK_FD                      10I 0 Value                      
D  BUFFER                         *   Value                      
D  BUFF_LENGTH                  10I 0 Value                      
D  FLAGS                        10I 0 Value                      
                                                                 
D*( CLOSE   のプロトタイプ宣言 )                                        
D CLOSE           PR            10I 0 ExtProc('close')                  
D  SOCK_FD                      10I 0 Value                             
                                                                        
D*( PERROR  のプロトタイプ宣言 )                                        
D PERROR          PR                  ExtProc('perror')                 
D  MSG                            *   Value                             
                                                                        
C     '* SOCKSVR *' DSPLY                   ANS               1         
C*( SOCKET の作成 )                                                     
C*--------------------------------------------------------------------+ 
C                   EVAL      SOCKFD = SOCKET(AF_INET:SOCK_STREAM:0)    
C*--------------------------------------------------------------------+ 
C     SOCKFD        IFLT      *ZEROS                                    
C                   CALLP     PERROR(%ADDR(SOCKET_ER))                  
C                   GOTO      END                                       
C                   END                                                 
C*( SOCKET オプションの設定 )                                           
C     'SOCKET OK'   DSPLY                                               
C*--------------------------------------------------------------------+ 
C                   EVAL      RC = SETSOCKOPT(SOCKFD: SOL_SOCKET:       
C                              SO_REUSEADDR: %ADDR(ON_PTR): LENOFON)    
C*--------------------------------------------------------------------+ 
C     RC            IFLT      *ZEROS                                    
C                   CALLP     PERROR(%ADDR(SOCKOPT_ER))                 
C                   GOTO      END                                       
C                   END                                                 
C     'SOCKOPT OK'  DSPLY                                               
C*( PORT=400 にバインドする )                                           
C                   EVAL      IADDR.SIN_FAMILY = AF_INET                
C                   EVAL      IADDR.SIN_PORT   = PORT                   
C                   EVAL      IADDR.S_ADDR     = INADDR_ANY             
C                   MOVE      *ALLX'00'     IADDR.ZERO                  
C*--------------------------------------------------------------------+ 
C                   EVAL      RC = BIND(SOCKFD: %ADDR(IADDR):           
C                                  %SIZE(IADDR))                        
C*--------------------------------------------------------------------+ 
C     RC            IFLT      *ZEROS                                    
C                   CALLP     PERROR(%ADDR(BIND_ER))                    
C                   GOTO      END                                       
C                   END                                                 
C     'BIND OK'     DSPLY                                               
C*( LISTEN  クライアントからの要求を待機する )                          
C*--------------------------------------------------------------------+ 
C                   EVAL      RC = LISTEN(SOCKFD:CLIENT)                
C*--------------------------------------------------------------------+ 
C     RC            IFLT      *ZEROS                                    
C                   CALLP     PERROR(%ADDR(LISTEN_ER))                  
C                   GOTO      END                                       
C                   END                                                 
C     'LISTEN OK'   DSPLY                                               
C*( ACCEPT  クライアントからの要求を受け入れる )                        
C*--------------------------------------------------------------------+ 
C                   EVAL      NEWFD = ACCEPT(SOCKFD:ADDR:%ADDR(SIZE))   
C*--------------------------------------------------------------------+ 
C     NEWFD         IFLT      *ZEROS                                    
C                   CALLP     PERROR(%ADDR(ACCEPT_ER))                  
C                   GOTO      END                                       
C                   END                                                 
C     'ACCEPT OK'   DSPLY                                               
C*( RECV    クライアントからのデータを読む )                            
C*--------------------------------------------------------------------+ 
C                   EVAL      RC = RECV(NEWFD: %ADDR(BUFF):             
C                                   TCP_LEN: 0)                         
C*--------------------------------------------------------------------+ 
C     RC            IFLT      *ZEROS                                    
C                   CALLP     PERROR(%ADDR(RECV_ER))                    
C                   GOTO      END                                       
C                   END                                                 
C     'RECV OK'     DSPLY                                               
C     'BUFF='       CAT(P)    BUFF:0        DSP40            40         
C     DSP40         DSPLY                                               
C*( SEND    クライアントにのデータを送信する )                          
C*                  MOVEL(P)  '*SOCK SERVER'BUFF                        
C     '*SOCK SERVER'CAT(P)    X'00':0       BUFF                        
C*--------------------------------------------------------------------+ 
C                   EVAL      RC = SEND(NEWFD: %ADDR(BUFF):             
C                                   TCP_LEN: 0)                         
C*--------------------------------------------------------------------+ 
C     RC            IFLT      *ZEROS                                    
C                   CALLP     PERROR(%ADDR(SEND_ER))                    
C                   GOTO      END                                       
C                   END                                                 
C     'SEND OK'     DSPLY                                               
C     '************'DSPLY                                             
C     '* SOCKSVR  *'DSPLY                                             
C     '*  E.O.J   *'DSPLY                                             
C     '************'DSPLY                                             
C*( CLOSE   ソケットを閉じて終了する )                                
C                   CALLP     CLOSE(NEWFD)                            
C                   CALLP     CLOSE(SOCKFD)                           
C     END           TAG                                               
C     ' '           DSPLY                   ANS               1       
C                   SETON                                        LR   
C                   RETURN
【 解説 】

コンパイルは CRTBNDRPG ではなく、

CRTRPGMOD MODULE(QTEMP/SOCKSVR) 
  SRCFILE(MYSRCLIB/QRPGLESRC) AUT(*ALL)
CRTPGM PGM(MYLIB/SOCKSVR) MODULE(QTEMP/SOCKSVR) 
  ACTGRP(*NEW) AUT(*ALL)

によって行う。
H 仕様書にバインド・ディレクリー QC2LE が指定されているのでコンパイラーには何も指示する必要はない。